From fa022b75eafb00482369079f71e528aabcd0b3d2 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Sun, 13 Apr 2025 11:52:17 +0100 Subject: [PATCH 01/26] WIP: complete arg parser --- Directory.Build.props | 1 + Playground/Domain.fs | 48 +++++ Playground/Library.fs | 358 +++++++++++++++++++++++++++++++++++ Playground/Playground.fsproj | 19 ++ Playground/Program.fs | 11 ++ WoofWare.Myriad.sln | 6 + 6 files changed, 443 insertions(+) create mode 100644 Playground/Domain.fs create mode 100644 Playground/Library.fs create mode 100644 Playground/Playground.fsproj create mode 100644 Playground/Program.fs diff --git a/Directory.Build.props b/Directory.Build.props index f0daa0b1..506a07b1 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -8,6 +8,7 @@ true embedded FS3388,FS3559 + $(NoWarn),NU1900 diff --git a/Playground/Domain.fs b/Playground/Domain.fs new file mode 100644 index 00000000..425d27b6 --- /dev/null +++ b/Playground/Domain.fs @@ -0,0 +1,48 @@ +namespace Playground + +open System +open WoofWare.Myriad.Plugins + +[] +type SubMode1 = + { + Info1 : int + Info2 : string + Rest : string list + } + +[] +type SubMode2 = + { + Info1 : int + Info2 : string + Rest : int list + } + +[] +type Mode1 = + { + Things : SubMode1 + Whatnot : int + } + +[] +type Mode2 = + { + Things : SubMode2 + Whatnot : DateTime + } + +[] +type Modes = + | Mode1 of Mode1 + | Mode2 of Mode2 + +[] +type Args = + { + WhatToDo : Modes + [] + OtherArgs : string list + } + diff --git a/Playground/Library.fs b/Playground/Library.fs new file mode 100644 index 00000000..7dd79002 --- /dev/null +++ b/Playground/Library.fs @@ -0,0 +1,358 @@ +// 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. + +namespace GeneratedParsers // 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 +// [] type SubMode1 = { Info1 : int; Info2 : string; Rest : string list } +// [] type SubMode2 = { Info1 : int; Info2 : string; Rest : int list } +// [] type Mode1 = { Things : SubMode1; Whatnot : int } +// [] type Mode2 = { Things : SubMode2; Whatnot : DateTime } +// [] type Modes = | Mode1 of Mode1 | Mode2 of Mode2 +// [] type Args = { WhatToDo : Modes; [] OtherArgs : string list } + + +/// Methods to parse arguments for the type Args +[] +module ArgsModule = + + //-------------------------------------------------------------------------- + // Internal state definitions for the multi-candidate DU parser + //-------------------------------------------------------------------------- + + /// 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 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 + } + + type private CandidateParseStateContents = + | Mode1 of State_Mode1 + | Mode2 of State_Mode2 + + /// 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" + } + + //-------------------------------------------------------------------------- + // 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 + + let parse' (getEnvironmentVariable: string -> string) (args: string list) : Args = + let ArgParser_errors = ResizeArray() // Global errors + + 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)" "") + ] + |> 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() + + //---------------------------------------------------------------------- + // Helper functions for applying args to DU candidates + //---------------------------------------------------------------------- + + /// 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 + + 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 + | 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 + () + + | 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 + | 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 + () + + /// 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 = + let mutable handled = false + for candidate in candidates_WhatToDo do + let initialConsumedCount = candidate.ConsumedArgIndices.Count + 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 + + + //---------------------------------------------------------------------- + // Main parsing loop + //---------------------------------------------------------------------- + let rec go (state: ParseState_Args) (args: (int * string) list) = + 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 -> + 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 + if not (consumedArgIndices_WhatToDo.Contains i) then + arg_OtherArgs.Add positionalArg + ) + go ParseState_Args.AwaitingArg [] // Go to end state + + elif arg.StartsWith("--", StringComparison.Ordinal) then + if arg = "--help" then + 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 + 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 + 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 + + + args |> List.mapi (fun i s -> (i, s)) |> go ParseState_Args.AwaitingArg + + //---------------------------------------------------------------------- + // Final Validation and Assembly + //---------------------------------------------------------------------- + + // 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 whatToDoResult = + match viableWinners with + | [] -> + ArgParser_errors.Add("No valid parse found for 'WhatToDo'.") + // Add specific errors from candidates if available + 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))) + 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 + + | 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)) + Unchecked.defaultof<_> // Error path + + // 2. Finalize OtherArgs + let otherArgsResult = arg_OtherArgs |> Seq.toList + + // 3. Assemble Final Result or Fail + if ArgParser_errors.Count > 0 then + ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s\n\nHelp Text:\n%s" (helpText()) + else + { WhatToDo = whatToDoResult; OtherArgs = otherArgsResult } + + /// Parses the command line arguments into an Args record. + let parse (args: string list) : Args = + parse' System.Environment.GetEnvironmentVariable args diff --git a/Playground/Playground.fsproj b/Playground/Playground.fsproj new file mode 100644 index 00000000..cddb718b --- /dev/null +++ b/Playground/Playground.fsproj @@ -0,0 +1,19 @@ + + + + net9.0 + true + Exe + + + + + + + + + + + + + diff --git a/Playground/Program.fs b/Playground/Program.fs new file mode 100644 index 00000000..a96d3b55 --- /dev/null +++ b/Playground/Program.fs @@ -0,0 +1,11 @@ +namespace Playground + +open GeneratedParsers + +module Program = + [] + let main argv = + ["--whatnot=2024-01-12";"--info1=4";"--info2=hi"] + |> ArgsModule.parse + |> printfn "%O" + 0 diff --git a/WoofWare.Myriad.sln b/WoofWare.Myriad.sln index 61d3d2ba..14f8b813 100644 --- a/WoofWare.Myriad.sln +++ b/WoofWare.Myriad.sln @@ -10,6 +10,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Att EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Attributes.Test", "WoofWare.Myriad.Plugins.Attributes\Test\WoofWare.Myriad.Plugins.Attributes.Test.fsproj", "{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Playground", "Playground\Playground.fsproj", "{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -36,5 +38,9 @@ Global {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Debug|Any CPU.Build.0 = Debug|Any CPU {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.ActiveCfg = Release|Any CPU {26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.Build.0 = Release|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.Build.0 = Debug|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.ActiveCfg = Release|Any CPU + {6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal 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 02/26] WIP: define the helper types --- ConsumePlugin/ConsumePlugin.fsproj | 4 + ConsumePlugin/GeneratedArgs.fs | 4457 ++--------------- Playground/Domain.fs | 1 - Playground/Library.fs | 733 ++- Playground/Program.fs | 7 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 629 +++ .../WoofWare.Myriad.Plugins.fsproj | 3 +- 7 files changed, 1519 insertions(+), 4315 deletions(-) create mode 100644 WoofWare.Myriad.Plugins/ShibaGenerator.fs diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj index 7d053e93..41927305 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 7a0752fd..f852cda1 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -8,2501 +8,455 @@ -namespace ConsumePlugin - -open System -open System.IO -open WoofWare.Myriad.Plugins +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 + } -/// 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) : FlagsIntoPositionalArgsInt = "TODO: now construct the object" + + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. + type private FlagsIntoPositionalArgsIntChoice_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" + 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 (args : string list) : BasicNoPositionals = - parse' System.Environment.GetEnvironmentVariable args + member this.Assemble (positionals : string list) : FlagsIntoPositionalArgs' = "TODO: now construct the object" 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 = +/// Methods to parse arguments for the type FlagsIntoPositionalArgs' +[] +module FlagsIntoPositionalArgs'ArgParse = + type private ParseState_FlagsIntoPositionalArgs' = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string - 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" + /// Extension methods for argument parsing + type FlagsIntoPositionalArgs' with - let parse (args : string list) : Basic = - parse' System.Environment.GetEnvironmentVariable args + 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 BasicWithIntPositionals -[] -module BasicWithIntPositionals = - type private ParseState_BasicWithIntPositionals = +/// 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 - 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" + /// Extension methods for argument parsing + type FlagsIntoPositionalArgsIntChoice with - let parse (args : string list) : BasicWithIntPositionals = - parse' System.Environment.GetEnvironmentVariable args + 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 LoadsOfTypes -[] -module LoadsOfTypes = - type private ParseState_LoadsOfTypes = +/// 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 - 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" + /// Extension methods for argument parsing + type FlagsIntoPositionalArgsInt with + + static member parse' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgsInt + = + failwith "todo" - let parse (args : string list) : LoadsOfTypes = - parse' System.Environment.GetEnvironmentVariable args + 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 LoadsOfTypesNoPositionals -[] -module LoadsOfTypesNoPositionals = - type private ParseState_LoadsOfTypesNoPositionals = +/// 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 - 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" + /// Extension methods for argument parsing + type FlagsIntoPositionalArgsChoice with - let parse (args : string list) : LoadsOfTypesNoPositionals = - parse' System.Environment.GetEnvironmentVariable args + 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 DatesAndTimes +/// Methods to parse arguments for the type FlagsIntoPositionalArgs [] -module DatesAndTimesArgParse = - type private ParseState_DatesAndTimes = +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 DatesAndTimes with + type FlagsIntoPositionalArgs 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' + (getEnvironmentVariable : string -> string) + (args : string list) + : FlagsIntoPositionalArgs + = + failwith "todo" - static member parse (args : string list) : DatesAndTimes = - DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args + 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 ParentRecord +/// Methods to parse arguments for the type ManyLongForms [] -module ParentRecordArgParse = - type private ParseState_ParentRecord = +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 ParentRecord with + type ManyLongForms 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' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = + failwith "todo" - static member parse (args : string list) : ParentRecord = - ParentRecord.parse' System.Environment.GetEnvironmentVariable args + 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 ParentRecordChildPos +/// Methods to parse arguments for the type ContainsFlagDefaultValue [] -module ParentRecordChildPosArgParse = - type private ParseState_ParentRecordChildPos = +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 ParentRecordChildPos with + type ContainsFlagDefaultValue 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' + (getEnvironmentVariable : string -> string) + (args : string list) + : ContainsFlagDefaultValue + = + failwith "todo" - static member parse (args : string list) : ParentRecordChildPos = - ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args + 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 ParentRecordSelfPos +/// Methods to parse arguments for the type ContainsFlagEnvVar [] -module ParentRecordSelfPosArgParse = - type private ParseState_ParentRecordSelfPos = +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 ParentRecordSelfPos with + type ContainsFlagEnvVar 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' (getEnvironmentVariable : string -> string) (args : string list) : ContainsFlagEnvVar = + failwith "todo" - static member parse (args : string list) : ParentRecordSelfPos = - ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args + 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 ChoicePositionals +/// Methods to parse arguments for the type WithFlagDu [] -module ChoicePositionalsArgParse = - type private ParseState_ChoicePositionals = +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 ChoicePositionals with + type WithFlagDu 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' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = + failwith "todo" - static member parse (args : string list) : ChoicePositionals = - ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args + static member parse (args : string list) : WithFlagDu = + WithFlagDu.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin open System @@ -2522,161 +476,7 @@ module ContainsBoolEnvVarArgParse = type ContainsBoolEnvVar with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsBoolEnvVar = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf - "%s bool%s%s" - (sprintf "--%s" "bool-var") - ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)") - "") - ] - |> String.concat "\n" - - let parser_LeftoverArgs : string ResizeArray = ResizeArray () - let mutable arg_0 : bool option = None - - /// Processes the key-value pair, returning Error if no key was matched. - /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). - /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - let processKeyValue (key : string) (value : string) : Result = - if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "bool-var") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - 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" + failwith "todo" static member parse (args : string list) : ContainsBoolEnvVar = ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args @@ -2686,1642 +486,209 @@ open System open System.IO open WoofWare.Myriad.Plugins -/// Methods to parse arguments for the type WithFlagDu +/// Methods to parse arguments for the type ChoicePositionals [] -module WithFlagDuArgParse = - type private ParseState_WithFlagDu = +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 WithFlagDu with + type ChoicePositionals 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' (getEnvironmentVariable : string -> string) (args : string list) : ChoicePositionals = + failwith "todo" - static member parse (args : string list) : WithFlagDu = - WithFlagDu.parse' System.Environment.GetEnvironmentVariable args + 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 ContainsFlagEnvVar +/// Methods to parse arguments for the type ParentRecordSelfPos [] -module ContainsFlagEnvVarArgParse = - type private ParseState_ContainsFlagEnvVar = +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 ContainsFlagEnvVar with + type ParentRecordSelfPos 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' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordSelfPos = + failwith "todo" - static member parse (args : string list) : ContainsFlagEnvVar = - ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args + 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 ContainsFlagDefaultValue +/// Methods to parse arguments for the type ParentRecordChildPos [] -module ContainsFlagDefaultValueArgParse = - type private ParseState_ContainsFlagDefaultValue = +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 ContainsFlagDefaultValue with + type ParentRecordChildPos 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' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordChildPos = + failwith "todo" - static member parse (args : string list) : ContainsFlagDefaultValue = - ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args + 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 ManyLongForms +/// Methods to parse arguments for the type ParentRecord [] -module ManyLongFormsArgParse = - type private ParseState_ManyLongForms = +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 ManyLongForms with + type ParentRecord 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' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = + failwith "todo" - static member parse (args : string list) : ManyLongForms = - ManyLongForms.parse' System.Environment.GetEnvironmentVariable args + 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 FlagsIntoPositionalArgs +/// Methods to parse arguments for the type DatesAndTimes [] -module FlagsIntoPositionalArgsArgParse = - type private ParseState_FlagsIntoPositionalArgs = +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 FlagsIntoPositionalArgs with + type DatesAndTimes 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' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = + failwith "todo" - static member parse (args : string list) : FlagsIntoPositionalArgs = - FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args + 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 FlagsIntoPositionalArgsChoice -[] -module FlagsIntoPositionalArgsChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsChoice = +/// 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 - /// 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" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypesNoPositionals = + failwith "todo" - static member parse (args : string list) : FlagsIntoPositionalArgsChoice = - FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args + 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 FlagsIntoPositionalArgsInt -[] -module FlagsIntoPositionalArgsIntArgParse = - type private ParseState_FlagsIntoPositionalArgsInt = +/// 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 - /// 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" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = failwith "todo" - static member parse (args : string list) : FlagsIntoPositionalArgsInt = - FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args + 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 FlagsIntoPositionalArgsIntChoice -[] -module FlagsIntoPositionalArgsIntChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsIntChoice = +/// 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 - /// 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" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicWithIntPositionals = + failwith "todo" - static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = - FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args + 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 FlagsIntoPositionalArgs' -[] -module FlagsIntoPositionalArgs'ArgParse = - type private ParseState_FlagsIntoPositionalArgs' = +/// 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 - /// Extension methods for argument parsing - type FlagsIntoPositionalArgs' with + let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = failwith "todo" - static member parse' - (getEnvironmentVariable : string -> string) - (args : string list) - : FlagsIntoPositionalArgs' - = - let ArgParser_errors = ResizeArray () - - let helpText () = - [ - (sprintf "%s string%s%s" (sprintf "--%s" "a") "" "") - (sprintf - "%s string%s%s" - (sprintf "--%s" "dont-grab-everything") - " (positional args) (can be repeated)" - "") - ] - |> String.concat "\n" - - let arg_1 : string ResizeArray = ResizeArray () - let mutable arg_0 : string option = None - - /// Processes the key-value pair, returning Error if no key was matched. - /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). - /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - let processKeyValue (key : string) (value : string) : Result = - if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then - match arg_0 with - | Some x -> - sprintf - "Argument '%s' was supplied multiple times: %s and %s" - (sprintf "--%s" "a") - (x.ToString ()) - (value.ToString ()) - |> ArgParser_errors.Add - - Ok () - | None -> - try - arg_0 <- value |> (fun x -> x) |> Some - Ok () - with _ as exc -> - exc.Message |> Some |> Error - else if - System.String.Equals ( - key, - sprintf "--%s" "dont-grab-everything", - System.StringComparison.OrdinalIgnoreCase - ) - then - value |> (fun x -> x) |> arg_1.Add - () |> Ok - else - Error None - - /// Returns false if we didn't set a value. - let setFlagValue (key : string) : bool = false - - let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = - match args with - | [] -> - match state with - | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> () - | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - if setFlagValue key then - () - else - sprintf - "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." - key - |> ArgParser_errors.Add - | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x)) - | arg :: args -> - match state with - | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> - if arg.StartsWith ("--", System.StringComparison.Ordinal) then - if arg = "--help" then - helpText () |> failwithf "Help text requested.\n%s" - else - let equals = arg.IndexOf (char 61) - - if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) - else - let key = arg.[0 .. equals - 1] - let value = arg.[equals + 1 ..] - - match processKeyValue key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | Error x -> - if false then - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - else - match x with - | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value - | Some msg -> - sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - else - arg |> (fun x -> x) |> arg_1.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - match processKeyValue key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args - | Error exc -> - if setFlagValue key then - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - else 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" + let parse (args : string list) : Basic = + parse' System.Environment.GetEnvironmentVariable args +namespace ConsumePlugin - static member parse (args : string list) : FlagsIntoPositionalArgs' = - FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args +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 425d27b6..9a0b80de 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 7dd79002..3951abda 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 - - /// 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" - } + static member Create () = + { + Info1 = None + Info2 = None + Rest = ResizeArray () + } + + /// Check completeness and assemble the SubMode2 record from state. + member this.Assemble () : Result = + let errors = ResizeArray () + + if this.Info1.IsNone then + errors.Add ("Argument '--info1' is required.") + + if this.Info2.IsNone then + errors.Add ("Argument '--info2' is required.") + // Rest is list, always 'complete' + + if errors.Count = 0 then + Ok + { + Info1 = this.Info1.Value + Info2 = this.Info2.Value + Rest = this.Rest |> Seq.toList + } + else + Error (errors |> Seq.toList) + + + /// State representing the parse progress for Mode1 record (references SubMode1 state) + type private State_Mode1 = + { + ThingsState : State_SubMode1 // Holds state for the nested record + mutable Whatnot : int option + } + + static member Create () = + { + ThingsState = State_SubMode1.Create () + Whatnot = None + } + + /// Check completeness and assemble the Mode1 record from state (including nested). + member this.Assemble () : Result = + let errors = ResizeArray () + + // Check direct fields + if this.Whatnot.IsNone then + errors.Add ("Argument '--whatnot' is required for Mode1.") + + // Assemble nested state (which includes its own validation) + let thingsResult = this.ThingsState.Assemble () + let mutable thingsValue = None + + match thingsResult with + | Ok v -> thingsValue <- Some v + | Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context + + if errors.Count = 0 then + Ok + { + Things = thingsValue.Value + Whatnot = this.Whatnot.Value + } + else + Error (errors |> Seq.toList) + + + /// State representing the parse progress for Mode2 record (references SubMode2 state) + type private State_Mode2 = + { + ThingsState : State_SubMode2 // Holds state for the nested record + mutable Whatnot : DateTime option + } + + static member Create () = + { + ThingsState = State_SubMode2.Create () + Whatnot = None + } + + /// Check completeness and assemble the Mode2 record from state (including nested). + member this.Assemble () : Result = + let errors = ResizeArray () + + // Check direct fields + if this.Whatnot.IsNone then + errors.Add ("Argument '--whatnot' is required for Mode2.") + + // Assemble nested state (which includes its own validation) + let thingsResult = this.ThingsState.Assemble () + let mutable thingsValue = Unchecked.defaultof<_> + + match thingsResult with + | Ok v -> thingsValue <- v + | Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context + + if errors.Count = 0 then + { + Things = thingsValue + Whatnot = this.Whatnot.Value + } + |> Ok + else + Error (errors |> Seq.toList) + + + /// State for a single candidate parse path for the Modes DU (Structure unchanged) + type private CandidateParseState_Modes = + { + CaseName : string // "Mode1" or "Mode2" + mutable IsViable : bool + Errors : ResizeArray // Errors specific to this candidate's path + ConsumedArgIndices : System.Collections.Generic.HashSet // Indices consumed *by this candidate* + CaseState : obj // Holds either State_Mode1 or State_Mode2 + } + + static member CreateMode1 () = + { + CaseName = "Mode1" + IsViable = true + Errors = ResizeArray () + ConsumedArgIndices = System.Collections.Generic.HashSet () + CaseState = State_Mode1.Create () :> obj + } + + static member CreateMode2 () = + { + CaseName = "Mode2" + IsViable = true + Errors = ResizeArray () + ConsumedArgIndices = System.Collections.Generic.HashSet () + CaseState = State_Mode2.Create () :> obj + } //-------------------------------------------------------------------------- // Main Parser Logic //-------------------------------------------------------------------------- type private ParseState_Args = - /// 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 + () + + 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 + () - 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 + //---------------------------------------------------------------------- + // 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 + try + state.Whatnot <- Some (Int32.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message + ) + + candidate.IsViable <- false + elif key = "--info1" || key = "--info2" || key = "--rest" then + applyKeyValueToSubMode1State argIndex keyIndex key value state.ThingsState candidate else - // Key not relevant to Mode1, ignore it for this candidate () + | "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" + ) - | 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 | 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 + try + state.Whatnot <- Some (DateTime.Parse value) + candidate.ConsumedArgIndices.Add argIndex |> ignore + candidate.ConsumedArgIndices.Add keyIndex |> ignore + with ex -> + candidate.Errors.Add ( + sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message + ) + + candidate.IsViable <- false + elif key = "--info1" || key = "--info2" || key = "--rest" then + applyKeyValueToSubMode2State argIndex keyIndex key value state.ThingsState candidate else - // Key not relevant to Mode2, ignore it for this candidate () + | _ -> failwith "Internal error: Unknown case name" - /// 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 = + // 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 + handled + 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 a96d3b55..81255ece 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 00000000..0df4735f --- /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 06978b63..8aaf294d 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -40,7 +40,8 @@ - + + From df6079e7636fa734a000bbfa85f0c4d6710bd32f Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Sun, 13 Apr 2025 20:34:52 +0100 Subject: [PATCH 03/26] WIP --- ConsumePlugin/GeneratedArgs.fs | 643 +++++++++++++++++++++- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 385 ++++++++++++- 2 files changed, 1001 insertions(+), 27 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index f852cda1..18681c8b 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -26,7 +26,42 @@ module private ArgParseHelpers_ConsumePlugin = Rest : string list } - member this.Assemble (positionals : string list) : BasicNoPositionals = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add "no value provided for Foo" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add "no value provided for Bar" + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add "no value provided for Baz" + Unchecked.defaultof<_> + + let arg3 : int list = this.Rest + + if errors.Count = 0 then + Ok + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + } + else + errors |> Seq.toList |> Error /// A partially-parsed Basic. type private Basic_InProgress = @@ -36,7 +71,43 @@ module private ArgParseHelpers_ConsumePlugin = Baz : System.Boolean option } - member this.Assemble (positionals : string list) : Basic = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add "no value provided for Foo" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add "no value provided for Bar" + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add "no value provided for Baz" + Unchecked.defaultof<_> + + let arg3 : string list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + } + else + errors |> Seq.toList |> Error /// A partially-parsed BasicWithIntPositionals. type private BasicWithIntPositionals_InProgress = @@ -46,7 +117,43 @@ module private ArgParseHelpers_ConsumePlugin = Baz : System.Boolean option } - member this.Assemble (positionals : string list) : BasicWithIntPositionals = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add "no value provided for Foo" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add "no value provided for Bar" + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add "no value provided for Baz" + Unchecked.defaultof<_> + + let arg3 : int list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + } + else + errors |> Seq.toList |> Error /// A partially-parsed LoadsOfTypes. type private LoadsOfTypes_InProgress = @@ -63,7 +170,81 @@ module private ArgParseHelpers_ConsumePlugin = YetAnotherOptionalThing : string option } - member this.Assemble (positionals : string list) : LoadsOfTypes = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add "no value provided for Foo" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add "no value provided for Bar" + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add "no value provided for Baz" + Unchecked.defaultof<_> + + let arg3 : FileInfo = + match this.SomeFile with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg4 : DirectoryInfo = + match this.SomeDirectory with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg5 : DirectoryInfo list = this.SomeList + let arg6 : int option = this.OptionalThingWithNoDefault + let arg7 : int list = positionals + let positionals = () + + let arg8 : Choice = + match this.OptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + let arg9 : Choice = + match this.AnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + let arg10 : Choice = + match this.YetAnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + if errors.Count = 0 then + Ok + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + Positionals = arg7 + OptionalThing = arg8 + AnotherOptionalThing = arg9 + YetAnotherOptionalThing = arg10 + } + else + errors |> Seq.toList |> Error /// A partially-parsed LoadsOfTypesNoPositionals. type private LoadsOfTypesNoPositionals_InProgress = @@ -80,7 +261,78 @@ module private ArgParseHelpers_ConsumePlugin = YetAnotherOptionalThing : string option } - member this.Assemble (positionals : string list) : LoadsOfTypesNoPositionals = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Foo with + | Some result -> result + | None -> + errors.Add "no value provided for Foo" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Bar with + | Some result -> result + | None -> + errors.Add "no value provided for Bar" + Unchecked.defaultof<_> + + let arg2 : bool = + match this.Baz with + | Some result -> result + | None -> + errors.Add "no value provided for Baz" + Unchecked.defaultof<_> + + let arg3 : FileInfo = + match this.SomeFile with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg4 : DirectoryInfo = + match this.SomeDirectory with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg5 : DirectoryInfo list = this.SomeList + let arg6 : int option = this.OptionalThingWithNoDefault + + let arg7 : Choice = + match this.OptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + let arg8 : Choice = + match this.AnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + let arg9 : Choice = + match this.YetAnotherOptionalThing with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + if errors.Count = 0 then + Ok + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + OptionalThing = arg7 + AnotherOptionalThing = arg8 + YetAnotherOptionalThing = arg9 + } + else + errors |> Seq.toList |> Error /// A partially-parsed DatesAndTimes. type private DatesAndTimes_InProgress = @@ -91,7 +343,47 @@ module private ArgParseHelpers_ConsumePlugin = InvariantExact : TimeSpan option } - member this.Assemble (positionals : string list) : DatesAndTimes = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : TimeSpan = + match this.Plain with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg1 : TimeSpan = + match this.Invariant with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg2 : TimeSpan = + match this.Exact with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg3 : TimeSpan = + match this.InvariantExact with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + Plain = arg0 + Invariant = arg1 + Exact = arg2 + InvariantExact = arg3 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ChildRecord. type private ChildRecord_InProgress = @@ -100,7 +392,31 @@ module private ArgParseHelpers_ConsumePlugin = Thing2 : System.String option } - member this.Assemble (positionals : string list) : ChildRecord = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Thing1 with + | Some result -> result + | None -> + errors.Add "no value provided for Thing1" + Unchecked.defaultof<_> + + let arg1 : string = + match this.Thing2 with + | Some result -> result + | None -> + errors.Add "no value provided for Thing2" + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + Thing1 = arg0 + Thing2 = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ParentRecord. type private ParentRecord_InProgress = @@ -109,7 +425,31 @@ module private ArgParseHelpers_ConsumePlugin = AndAnother : System.Boolean option } - member this.Assemble (positionals : string list) : ParentRecord = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : ChildRecord = + match this.Child with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg1 : bool = + match this.AndAnother with + | Some result -> result + | None -> + errors.Add "no value provided for AndAnother" + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + Child = arg0 + AndAnother = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ChildRecordWithPositional. type private ChildRecordWithPositional_InProgress = @@ -117,7 +457,27 @@ module private ArgParseHelpers_ConsumePlugin = Thing1 : System.Int32 option } - member this.Assemble (positionals : string list) : ChildRecordWithPositional = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : int = + match this.Thing1 with + | Some result -> result + | None -> + errors.Add "no value provided for Thing1" + Unchecked.defaultof<_> + + let arg1 : Uri list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + Thing1 = arg0 + Thing2 = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ParentRecordChildPos. type private ParentRecordChildPos_InProgress = @@ -126,7 +486,31 @@ module private ArgParseHelpers_ConsumePlugin = AndAnother : System.Boolean option } - member this.Assemble (positionals : string list) : ParentRecordChildPos = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : ChildRecordWithPositional = + match this.Child with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg1 : bool = + match this.AndAnother with + | Some result -> result + | None -> + errors.Add "no value provided for AndAnother" + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + Child = arg0 + AndAnother = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ParentRecordSelfPos. type private ParentRecordSelfPos_InProgress = @@ -134,7 +518,27 @@ module private ArgParseHelpers_ConsumePlugin = Child : ChildRecord_InProgress } - member this.Assemble (positionals : string list) : ParentRecordSelfPos = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : ChildRecord = + match this.Child with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + let arg1 : bool list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + Child = arg0 + AndAnother = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ChoicePositionals. type private ChoicePositionals_InProgress = @@ -142,7 +546,18 @@ module private ArgParseHelpers_ConsumePlugin = _Dummy : unit } - member this.Assemble (positionals : string list) : ChoicePositionals = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + let arg0 : Choice list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + Args = arg0 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ContainsBoolEnvVar. type private ContainsBoolEnvVar_InProgress = @@ -150,7 +565,21 @@ module private ArgParseHelpers_ConsumePlugin = BoolVar : bool option } - member this.Assemble (positionals : string list) : ContainsBoolEnvVar = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : Choice = + match this.BoolVar with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + if errors.Count = 0 then + Ok + { + BoolVar = arg0 + } + else + errors |> Seq.toList |> Error /// A partially-parsed WithFlagDu. type private WithFlagDu_InProgress = @@ -158,7 +587,23 @@ module private ArgParseHelpers_ConsumePlugin = DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : WithFlagDu = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : DryRunMode = + match this.DryRun with + | Ok result -> result + | Error err -> + err.AddRange errors + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + DryRun = arg0 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ContainsFlagEnvVar. type private ContainsFlagEnvVar_InProgress = @@ -166,7 +611,21 @@ module private ArgParseHelpers_ConsumePlugin = DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : ContainsFlagEnvVar = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : Choice = + match this.DryRun with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + if errors.Count = 0 then + Ok + { + DryRun = arg0 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ContainsFlagDefaultValue. type private ContainsFlagDefaultValue_InProgress = @@ -174,7 +633,21 @@ module private ArgParseHelpers_ConsumePlugin = DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : ContainsFlagDefaultValue = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : Choice = + match this.DryRun with + | Some result -> Choice1Of2 result + | None -> Choice2Of2 "TODO" + + if errors.Count = 0 then + Ok + { + DryRun = arg0 + } + else + errors |> Seq.toList |> Error /// A partially-parsed ManyLongForms. type private ManyLongForms_InProgress = @@ -183,7 +656,31 @@ module private ArgParseHelpers_ConsumePlugin = SomeFlag : System.Boolean option } - member this.Assemble (positionals : string list) : ManyLongForms = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.DoTheThing with + | Some result -> result + | None -> + errors.Add "no value provided for DoTheThing" + Unchecked.defaultof<_> + + let arg1 : bool = + match this.SomeFlag with + | Some result -> result + | None -> + errors.Add "no value provided for SomeFlag" + Unchecked.defaultof<_> + + if errors.Count = 0 then + Ok + { + DoTheThing = arg0 + SomeFlag = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed FlagsIntoPositionalArgs. type private FlagsIntoPositionalArgs_InProgress = @@ -191,7 +688,27 @@ module private ArgParseHelpers_ConsumePlugin = A : System.String option } - member this.Assemble (positionals : string list) : FlagsIntoPositionalArgs = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add "no value provided for A" + Unchecked.defaultof<_> + + let arg1 : string list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + A = arg0 + GrabEverything = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed FlagsIntoPositionalArgsChoice. type private FlagsIntoPositionalArgsChoice_InProgress = @@ -199,8 +716,27 @@ module private ArgParseHelpers_ConsumePlugin = A : System.String option } - member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsChoice = - "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add "no value provided for A" + Unchecked.defaultof<_> + + let arg1 : Choice list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + A = arg0 + GrabEverything = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed FlagsIntoPositionalArgsInt. type private FlagsIntoPositionalArgsInt_InProgress = @@ -208,7 +744,27 @@ module private ArgParseHelpers_ConsumePlugin = A : System.String option } - member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsInt = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add "no value provided for A" + Unchecked.defaultof<_> + + let arg1 : int list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + A = arg0 + GrabEverything = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type private FlagsIntoPositionalArgsIntChoice_InProgress = @@ -216,8 +772,27 @@ module private ArgParseHelpers_ConsumePlugin = A : System.String option } - member this.Assemble (positionals : string list) : FlagsIntoPositionalArgsIntChoice = - "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add "no value provided for A" + Unchecked.defaultof<_> + + let arg1 : Choice list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + A = arg0 + GrabEverything = arg1 + } + else + errors |> Seq.toList |> Error /// A partially-parsed FlagsIntoPositionalArgs'. type private FlagsIntoPositionalArgs'_InProgress = @@ -225,7 +800,27 @@ module private ArgParseHelpers_ConsumePlugin = A : System.String option } - member this.Assemble (positionals : string list) : FlagsIntoPositionalArgs' = "TODO: now construct the object" + member this.Assemble (positionals : string list) : Result = + let errors = ResizeArray () + + let arg0 : string = + match this.A with + | Some result -> result + | None -> + errors.Add "no value provided for A" + Unchecked.defaultof<_> + + let arg1 : string list = positionals + let positionals = () + + if errors.Count = 0 then + Ok + { + A = arg0 + DontGrabEverything = arg1 + } + else + errors |> Seq.toList |> Error namespace ConsumePlugin open System diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 0df4735f..00882739 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -96,6 +96,244 @@ module internal ShibaGenerator = | Union unionType -> unionType.Name | Record recordType -> recordType.Name + let private identifyAsFlag (flagDus : FlagDu list) (ty : SynType) : FlagDu option = + match ty with + | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> + flagDus + |> List.tryPick (fun du -> + let duName = du.Name.idText + let ident = List.last(ident).idText + if duName = ident then Some du else None + ) + | _ -> None + + type private ParseFunctionSpec<'choice> = + /// A leaf node, e.g. `--foo=3`. Call the `parseFn` to turn the input `"3"` into the `typeAfterParse` (here, `int`). + /// `Accumulation` represents essentially how many times this leaf is expected to be called. + | Leaf of parseFn : SynExpr * acc : Accumulation<'choice> * typeAfterParse : SynType + /// An opaque node we didn't recognise: e.g. `Foo : SomeType`. + /// We're probably going to stamp out an "in-progress" type for this node. + /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) + | UserDefined + /// An optional opaque node we didn't recognise: e.g. `Foo : SomeType option`. + /// We're probably going to stamp out an "in-progress" type for this node. + /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) + | OptionOfUserDefined + + /// Builds a function or lambda of one string argument, which returns a `ty` (as modified by the `Accumulation`; + /// for example, maybe it returns a `ty option` or a `ty list`). + /// The resulting SynType, if you get one, is the type of the *element* being parsed; so if the Accumulation is List, the SynType + /// is the list element. + let rec private createParseFunction<'choice> + (choice : ArgumentDefaultSpec option -> 'choice) + (flagDus : FlagDu list) + (fieldName : Ident) + (attrs : SynAttribute list) + (ty : SynType) + : ParseFunctionSpec<'choice> + = + match ty with + | String -> + ParseFunctionSpec.Leaf ( + SynExpr.createLambda "x" (SynExpr.createIdent "x"), + Accumulation.Required, + SynType.string + ) + | PrimitiveType pt -> + ParseFunctionSpec.Leaf ( + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent' (pt @ [ Ident.create "Parse" ])) + (SynExpr.createIdent "x")), + Accumulation.Required, + ty + ) + | Uri -> + ParseFunctionSpec.Leaf ( + SynExpr.createLambda + "x" + (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Uri" ]) (SynExpr.createIdent "x")), + Accumulation.Required, + ty + ) + | TimeSpan -> + let parseExact = + attrs + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (idents, _, _) -> + match idents |> List.map (fun i -> i.idText) |> List.tryLast with + | Some "ParseExactAttribute" + | Some "ParseExact" -> Some attr.ArgExpr + | _ -> None + ) + + let culture = + attrs + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (idents, _, _) -> + match idents |> List.map (fun i -> i.idText) |> List.tryLast with + | Some "InvariantCultureAttribute" + | Some "InvariantCulture" -> Some () + | _ -> None + ) + + let parser = + match parseExact, culture with + | None, None -> + SynExpr.createIdent "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "Parse" ]) + | Some format, None -> + [ + SynExpr.createIdent "x" + format + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "CurrentCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "ParseExact" ]) + | None, Some () -> + [ + SynExpr.createIdent "x" + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "InvariantCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "Parse" ]) + | Some format, Some () -> + [ + SynExpr.createIdent "x" + format + SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "InvariantCulture" ] + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "ParseExact" ]) + |> SynExpr.createLambda "x" + + ParseFunctionSpec.Leaf (parser, Accumulation.Required, ty) + | FileInfo -> + ParseFunctionSpec.Leaf ( + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "FileInfo" ]) + (SynExpr.createIdent "x")), + Accumulation.Required, + ty + ) + | DirectoryInfo -> + ParseFunctionSpec.Leaf ( + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "DirectoryInfo" ]) + (SynExpr.createIdent "x")), + Accumulation.Required, + ty + ) + | OptionType eltTy -> + match createParseFunction choice flagDus fieldName attrs eltTy with + | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> + match acc with + | Accumulation.Optional -> + failwith + $"ArgParser does not support optionals containing options at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Choice _ -> + failwith + $"ArgParser does not support optionals containing choices at field %s{fieldName.idText}: %O{ty}" + | Accumulation.List _ -> + failwith $"ArgParser does not support optional lists at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Required -> ParseFunctionSpec.Leaf (parseElt, Accumulation.Optional, childTy) + | ParseFunctionSpec.UserDefined -> ParseFunctionSpec.OptionOfUserDefined + | ParseFunctionSpec.OptionOfUserDefined -> + failwith $"ArgParser does not support lists of options at field %s{fieldName.idText}" + | ChoiceType elts -> + match elts with + | [ elt1 ; elt2 ] -> + if not (SynType.provablyEqual elt1 elt2) then + failwith + $"ArgParser was unable to prove types %O{elt1} and %O{elt2} to be equal in a Choice. We require them to be equal." + + match createParseFunction choice flagDus fieldName attrs elt1 with + | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> + match acc with + | Accumulation.Optional -> + failwith + $"ArgParser does not support choices containing options at field %s{fieldName.idText}: %O{ty}" + | Accumulation.List _ -> + failwith + $"ArgParser does not support choices containing lists at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Choice _ -> + failwith + $"ArgParser does not support choices containing choices at field %s{fieldName.idText}: %O{ty}" + | Accumulation.Required -> + + let relevantAttrs = + attrs + |> List.choose (fun attr -> + let (SynLongIdent.SynLongIdent (name, _, _)) = attr.TypeName + + match name |> List.map _.idText with + | [ "ArgumentDefaultFunction" ] + | [ "ArgumentDefaultFunctionAttribute" ] + | [ "Plugins" ; "ArgumentDefaultFunction" ] + | [ "Plugins" ; "ArgumentDefaultFunctionAttribute" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultFunction" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultFunctionAttribute" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultFunction" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultFunctionAttribute" ] -> + ArgumentDefaultSpec.FunctionCall (Ident.create ("Default" + fieldName.idText)) + |> Some + | [ "ArgumentDefaultEnvironmentVariable" ] + | [ "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ] + | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] -> + + ArgumentDefaultSpec.EnvironmentVariable attr.ArgExpr |> Some + | _ -> None + ) + + let relevantAttr = + match relevantAttrs with + | [] -> None + | [ x ] -> Some x + | _ -> + failwith + $"Expected Choice to be annotated with at most one ArgumentDefaultFunction or similar, but it was annotated with multiple. Field: %s{fieldName.idText}" + + ParseFunctionSpec.Leaf (parseElt, Accumulation.Choice (choice relevantAttr), childTy) + | _ -> + failwith + $"Choices are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString elt1}" + | elts -> + let elts = elts |> List.map string |> String.concat ", " + + failwith + $"ArgParser requires Choice to be of the form Choice<'a, 'a>; that is, two arguments, both the same. For field %s{fieldName.idText}, got: %s{elts}" + | ListType eltTy -> + match createParseFunction choice flagDus fieldName attrs eltTy with + | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> + ParseFunctionSpec.Leaf (parseElt, Accumulation.List acc, childTy) + | _ -> + failwith + $"Lists are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString eltTy}" + | ty -> + match identifyAsFlag flagDus ty with + | None -> ParseFunctionSpec.UserDefined + | Some flagDu -> + // Parse as a bool, and then do the `if-then` dance. + let parser = + SynExpr.createIdent "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ]) + |> FlagDu.FromBoolean flagDu + |> SynExpr.createLambda "x" + + ParseFunctionSpec.Leaf (parser, Accumulation.Required, ty) + /// Some types don't have in-progress equivalents (e.g. a no-data DU, which is "basically primitive"); /// hence the `option`. let createInProgressRecognisedType @@ -104,6 +342,7 @@ module internal ShibaGenerator = (ty : RecognisedType) : RecordType option = + /// Get the "in-progress type" corresponding to the type with this name. let getInProgressTypeName (ty : LongIdent) : SynType = // TODO: this is super jank let ident = List.last ty @@ -198,7 +437,9 @@ module internal ShibaGenerator = [ SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") ] - |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ union.Name ]) + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.createLongIdent [ union.Name ] ; SynType.list SynType.string ] + ) |> SynMemberDefn.memberImplementation |> List.singleton |> Some @@ -260,13 +501,151 @@ module internal ShibaGenerator = else l Members = - SynExpr.CreateConst "TODO: now construct the object" + // for each field `FieldName` in order, we've made a variable `arg%i` + // which has done the optionality check + let instantiation = + record.Fields + |> List.mapi (fun i (SynField.SynField (idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Name.idText} to have a name, but it did not" + | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" + ) + |> AstHelper.instantiateRecord + |> SynExpr.applyFunction (SynExpr.createIdent "Ok") + + let defaultOf = + SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) + + let assignVariables = + record.Fields + |> List.mapi (fun i f -> (i, f)) + |> List.collect (fun + (i, SynField.SynField (attributes = attrs ; fieldType = ty ; idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Name.idText} to have a name, but it did not" + | Some ident -> + // TODO: jank conditional + if + attrs + |> SynAttributes.toAttrs + |> List.exists (fun x -> + List.last(x.TypeName.LongIdent).idText.StartsWith "PositionalArgs" + ) + then + // Positional args carried in from external argument + [ + SynBinding.basic + [ Ident.create $"arg%i{i}" ] + [] + (SynExpr.createIdent "positionals") + |> SynBinding.withReturnAnnotation ty + // prevent further usages of positional args + SynBinding.basic [ Ident.create "positionals" ] [] (SynExpr.CreateConst ()) + ] + else + let extract = + match ty with + | ChoiceType [ _ ; _ ] -> + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.applyFunction + (SynExpr.createIdent "Choice1Of2") + (SynExpr.createIdent "result")) + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (SynExpr.CreateConst "TODO" + |> SynExpr.applyFunction (SynExpr.createIdent "Choice2Of2")) + ] + |> SynExpr.createMatch ( + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + ) + | ListType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | PrimitiveType _ -> + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.createIdent "result") + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "Add" + (SynExpr.CreateConst + $"no value provided for %s{ident.idText}") + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch ( + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + ) + | OptionType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | SynType.LongIdent (SynLongIdent.SynLongIdent _) -> + // TODO: need to know if it has positionals + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Ok" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.createIdent "result") + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Error" ] + (SynArgPats.create [ SynPat.named "err" ])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "AddRange" + (SynExpr.createIdent "errors") + (SynExpr.createIdent "err") + defaultOf + ]) + ] + |> SynExpr.createMatch ( + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + ) + | ty -> failwith $"TODO: got type {ty} which we don't know how to handle" + + extract + |> SynBinding.basic [ Ident.create $"arg%i{i}" ] [] + |> SynBinding.withReturnAnnotation ty + |> List.singleton + ) + + SynExpr.ifThenElse + (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) + (SynExpr.createIdent "errors" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + instantiation + |> SynExpr.createLet assignVariables + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors" ] + [] + (SynExpr.applyFunction + (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) + (SynExpr.CreateConst ())) + ] |> SynBinding.basic [ Ident.create "this" ; Ident.create "Assemble" ] [ SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") ] - |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.Name ]) + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.createLongIdent [ record.Name ] ; SynType.list SynType.string ] + ) |> SynMemberDefn.memberImplementation |> List.singleton |> Some From 8535481e0ddb0ae809bbb57eda67a5bb2206b884 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Sun, 13 Apr 2025 21:09:12 +0100 Subject: [PATCH 04/26] Bump Whippet --- WoofWare.Myriad.Plugins/ArgParserGenerator.fs | 2 +- WoofWare.Myriad.Plugins/AstHelper.fs | 7 ------- WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs | 2 +- WoofWare.Myriad.Plugins/JsonParseGenerator.fs | 2 +- WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs | 2 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 2 +- WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj | 2 +- 7 files changed, 6 insertions(+), 13 deletions(-) diff --git a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs index 0235b111..fb33747d 100644 --- a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs +++ b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs @@ -673,7 +673,7 @@ module internal ArgParserGenerator = args |> Map.toList |> List.map (fun (ident, expr) -> SynLongIdent.create [ Ident.create ident ], expr) - |> AstHelper.instantiateRecord + |> SynExpr.createRecord None ) tree, counter diff --git a/WoofWare.Myriad.Plugins/AstHelper.fs b/WoofWare.Myriad.Plugins/AstHelper.fs index 79a14b8d..d1686722 100644 --- a/WoofWare.Myriad.Plugins/AstHelper.fs +++ b/WoofWare.Myriad.Plugins/AstHelper.fs @@ -36,13 +36,6 @@ module internal AstHelper = | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum _, _) -> true | _ -> false - let instantiateRecord (fields : (SynLongIdent * SynExpr) list) : SynExpr = - let fields = - fields - |> List.map (fun (rfn, synExpr) -> SynExprRecordField ((rfn, true), Some range0, Some synExpr, None)) - - SynExpr.Record (None, None, fields, range0) - let defineRecordType (record : RecordType) : SynTypeDefn = let name = SynComponentInfo.create record.Name diff --git a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs index a1888285..8ccb6de9 100644 --- a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs +++ b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs @@ -89,7 +89,7 @@ module internal InterfaceMockGenerator = [] else [ SynPat.unit ]) - (AstHelper.instantiateRecord constructorFields) + (SynExpr.createRecord None constructorFields) |> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.") |> SynBinding.withReturnAnnotation constructorReturnType |> SynMemberDefn.staticMember diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs index 6e3a57c8..173c5f88 100644 --- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs @@ -480,7 +480,7 @@ module internal JsonParseGenerator = let finalConstruction = fields |> List.mapi (fun i fieldData -> SynLongIdent.createI fieldData.Ident, SynExpr.createIdent $"arg_%i{i}") - |> AstHelper.instantiateRecord + |> SynExpr.createRecord None (finalConstruction, assignments) ||> List.fold (fun final assignment -> SynExpr.createLet [ assignment ] final) diff --git a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs index 3ff25ab6..5039a012 100644 --- a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs +++ b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs @@ -97,7 +97,7 @@ module internal RemoveOptionsGenerator = SynLongIdent.createI fieldData.Ident, body ) - |> AstHelper.instantiateRecord + |> SynExpr.createRecord None SynBinding.basic [ functionName ] diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 00882739..bb0355a5 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -512,7 +512,7 @@ module internal ShibaGenerator = $"expected field in record %s{record.Name.idText} to have a name, but it did not" | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" ) - |> AstHelper.instantiateRecord + |> SynExpr.createRecord None |> SynExpr.applyFunction (SynExpr.createIdent "Ok") let defaultOf = diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 8aaf294d..da03107f 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -22,7 +22,7 @@ - + From 0c5ddf9df7e94f9f89500ab9776b125f3e180491 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Mon, 14 Apr 2025 00:01:55 +0100 Subject: [PATCH 05/26] WIP --- ConsumePlugin/GeneratedArgs.fs | 106 +-- .../ArgParserAttributes.fs | 5 + WoofWare.Myriad.Plugins/ArgParserGenerator.fs | 137 +-- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 848 ++++++++++++++---- .../WoofWare.Myriad.Plugins.fsproj | 4 +- 5 files changed, 740 insertions(+), 360 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 18681c8b..2cfb5b68 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -20,10 +20,10 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed BasicNoPositionals. type private BasicNoPositionals_InProgress = { - Foo : System.Int32 option - Bar : System.String option - Baz : System.Boolean option - Rest : string list + mutable Foo : System.Int32 option + mutable Bar : System.String option + mutable Baz : System.Boolean option + mutable Rest : string list } member this.Assemble (positionals : string list) : Result = @@ -66,9 +66,9 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed Basic. type private Basic_InProgress = { - Foo : System.Int32 option - Bar : System.String option - Baz : System.Boolean option + mutable Foo : System.Int32 option + mutable Bar : System.String option + mutable Baz : System.Boolean option } member this.Assemble (positionals : string list) : Result = @@ -112,9 +112,9 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed BasicWithIntPositionals. type private BasicWithIntPositionals_InProgress = { - Foo : System.Int32 option - Bar : System.String option - Baz : System.Boolean option + mutable Foo : System.Int32 option + mutable Bar : System.String option + mutable Baz : System.Boolean option } member this.Assemble (positionals : string list) : Result = @@ -158,16 +158,16 @@ module private ArgParseHelpers_ConsumePlugin = /// 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 + mutable Foo : System.Int32 option + mutable Bar : System.String option + mutable Baz : System.Boolean option + mutable SomeFile : FileInfo option + mutable SomeDirectory : DirectoryInfo option + mutable SomeList : string list + mutable OptionalThingWithNoDefault : int option + mutable OptionalThing : bool option + mutable AnotherOptionalThing : int option + mutable YetAnotherOptionalThing : string option } member this.Assemble (positionals : string list) : Result = @@ -249,16 +249,16 @@ module private ArgParseHelpers_ConsumePlugin = /// 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 + mutable Foo : System.Int32 option + mutable Bar : System.String option + mutable Baz : System.Boolean option + mutable SomeFile : FileInfo option + mutable SomeDirectory : DirectoryInfo option + mutable SomeList : string list + mutable OptionalThingWithNoDefault : int option + mutable OptionalThing : bool option + mutable AnotherOptionalThing : int option + mutable YetAnotherOptionalThing : string option } member this.Assemble (positionals : string list) : Result = @@ -337,10 +337,10 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed DatesAndTimes. type private DatesAndTimes_InProgress = { - Plain : TimeSpan option - Invariant : TimeSpan option - Exact : TimeSpan option - InvariantExact : TimeSpan option + mutable Plain : TimeSpan option + mutable Invariant : TimeSpan option + mutable Exact : TimeSpan option + mutable InvariantExact : TimeSpan option } member this.Assemble (positionals : string list) : Result = @@ -388,8 +388,8 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChildRecord. type private ChildRecord_InProgress = { - Thing1 : System.Int32 option - Thing2 : System.String option + mutable Thing1 : System.Int32 option + mutable Thing2 : System.String option } member this.Assemble (positionals : string list) : Result = @@ -421,8 +421,8 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecord. type private ParentRecord_InProgress = { - Child : ChildRecord_InProgress - AndAnother : System.Boolean option + mutable Child : ChildRecord_InProgress + mutable AndAnother : System.Boolean option } member this.Assemble (positionals : string list) : Result = @@ -454,7 +454,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChildRecordWithPositional. type private ChildRecordWithPositional_InProgress = { - Thing1 : System.Int32 option + mutable Thing1 : System.Int32 option } member this.Assemble (positionals : string list) : Result = @@ -482,8 +482,8 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecordChildPos. type private ParentRecordChildPos_InProgress = { - Child : ChildRecordWithPositional_InProgress - AndAnother : System.Boolean option + mutable Child : ChildRecordWithPositional_InProgress + mutable AndAnother : System.Boolean option } member this.Assemble (positionals : string list) : Result = @@ -515,7 +515,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecordSelfPos. type private ParentRecordSelfPos_InProgress = { - Child : ChildRecord_InProgress + mutable Child : ChildRecord_InProgress } member this.Assemble (positionals : string list) : Result = @@ -562,7 +562,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ContainsBoolEnvVar. type private ContainsBoolEnvVar_InProgress = { - BoolVar : bool option + mutable BoolVar : bool option } member this.Assemble (positionals : string list) : Result = @@ -584,7 +584,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed WithFlagDu. type private WithFlagDu_InProgress = { - DryRun : DryRunMode option + mutable DryRun : DryRunMode option } member this.Assemble (positionals : string list) : Result = @@ -608,7 +608,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ContainsFlagEnvVar. type private ContainsFlagEnvVar_InProgress = { - DryRun : DryRunMode option + mutable DryRun : DryRunMode option } member this.Assemble (positionals : string list) : Result = @@ -630,7 +630,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ContainsFlagDefaultValue. type private ContainsFlagDefaultValue_InProgress = { - DryRun : DryRunMode option + mutable DryRun : DryRunMode option } member this.Assemble (positionals : string list) : Result = @@ -652,8 +652,8 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ManyLongForms. type private ManyLongForms_InProgress = { - DoTheThing : System.String option - SomeFlag : System.Boolean option + mutable DoTheThing : System.String option + mutable SomeFlag : System.Boolean option } member this.Assemble (positionals : string list) : Result = @@ -685,7 +685,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgs. type private FlagsIntoPositionalArgs_InProgress = { - A : System.String option + mutable A : System.String option } member this.Assemble (positionals : string list) : Result = @@ -713,7 +713,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsChoice. type private FlagsIntoPositionalArgsChoice_InProgress = { - A : System.String option + mutable A : System.String option } member this.Assemble (positionals : string list) : Result = @@ -741,7 +741,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsInt. type private FlagsIntoPositionalArgsInt_InProgress = { - A : System.String option + mutable A : System.String option } member this.Assemble (positionals : string list) : Result = @@ -769,7 +769,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type private FlagsIntoPositionalArgsIntChoice_InProgress = { - A : System.String option + mutable A : System.String option } member this.Assemble (positionals : string list) : Result = @@ -797,7 +797,7 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgs'. type private FlagsIntoPositionalArgs'_InProgress = { - A : System.String option + mutable A : System.String option } member this.Assemble (positionals : string list) : Result = diff --git a/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs b/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs index f9b34c25..1ca3e63a 100644 --- a/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs +++ b/WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs @@ -26,6 +26,11 @@ type ArgParserAttribute (isExtensionMethod : bool) = /// an argument which looks like a flag but which we don't recognise.) /// We will still interpret `--help` as requesting help, unless it comes after /// a standalone `--` separator. +/// +/// If the type of the PositionalArgs field is `Choice<'a, 'a>`, then we will +/// tell you whether each arg came before or after a standalone `--` separator. +/// For example, `MyApp foo bar -- baz` with PositionalArgs of `Choice` +/// would yield `Choice1Of2 foo, Choice1Of2 bar, Choice2Of2 baz`. type PositionalArgsAttribute (includeFlagLike : bool) = inherit Attribute () diff --git a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs index fb33747d..dd075d0f 100644 --- a/WoofWare.Myriad.Plugins/ArgParserGenerator.fs +++ b/WoofWare.Myriad.Plugins/ArgParserGenerator.fs @@ -7,82 +7,6 @@ open Fantomas.FCS.Text.Range open TypeEquality open WoofWare.Whippet.Fantomas -type internal ArgParserOutputSpec = - { - ExtensionMethods : bool - } - -type internal FlagDu = - { - Name : Ident - Case1Name : Ident - Case2Name : Ident - /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal - Case1Arg : SynExpr - /// Hopefully this is simply the const bool True or False, but it might e.g. be a literal - Case2Arg : SynExpr - } - - static member FromBoolean (flagDu : FlagDu) (value : SynExpr) = - SynExpr.ifThenElse - (SynExpr.equals value flagDu.Case1Arg) - (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]) - (SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]) - -/// The default value of an argument which admits default values can be pulled from different sources. -/// This defines which source a particular default value comes from. -type private ArgumentDefaultSpec = - /// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever). - | EnvironmentVariable of name : SynExpr - /// From calling the static member `{typeWeParseInto}.Default{name}()` - /// For example, if `type MyArgs = { Thing : Choice }`, then - /// we would use `MyArgs.DefaultThing () : int`. - /// - | FunctionCall of name : Ident - -type private Accumulation<'choice> = - | Required - | Optional - | Choice of 'choice - | List of Accumulation<'choice> - -type private ParseFunction<'acc> = - { - FieldName : Ident - TargetVariable : Ident - /// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might - /// get confused with positional args or something! I haven't thought that hard about this. - /// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have - /// omitted the initial `--` that will be required at runtime. - ArgForm : SynExpr list - /// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different: - /// we should lie to the user about the value of the cases there. - /// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g. - /// "0" instead of "false", we need to know if we're reading a bool. - /// In that case, `boolCases` is Some, and contains the construction of the flag (or boolean, in which case - /// you get no data). - BoolCases : Choice option - Help : SynExpr option - /// A function string -> %TargetType%, where TargetVariable is probably a `%TargetType% option`. - /// (Depending on `Accumulation`, we'll remove the `option` at the end of the parse, asserting that the - /// argument was supplied.) - /// This is allowed to throw if it fails to parse. - Parser : SynExpr - /// If `Accumulation` is `List`, then this is the type of the list *element*; analogously for optionals - /// and choices and so on. - TargetType : SynType - Accumulation : 'acc - } - - /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all - /// the ways they can refer to this arg. - member arg.HumanReadableArgForm : SynExpr = - let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / " - - (SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm) - ||> List.fold SynExpr.applyFunction - |> SynExpr.paren - [] type private ChoicePositional = | Normal of includeFlagLike : SynExpr option @@ -114,14 +38,14 @@ type private ParseTree<'hasPositional> = /// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in /// the branch (e.g. each record field name), /// and composes them into a `SynExpr` (e.g. the record-typed object). - | Branch of + | DescendRecord of fields : (Ident * ParseTree) list * assemble : (Map -> SynExpr) * Teq<'hasPositional, HasNoPositional> /// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in /// the branch (e.g. each record field name), /// and composes them into a `SynExpr` (e.g. the record-typed object). - | BranchPos of + | DescendRecordPos of posField : Ident * fields : ParseTree * (Ident * ParseTree) list * @@ -184,63 +108,6 @@ module private ParseTree = go None ([], None) subs - let rec accumulatorsNonPos (tree : ParseTree) : ParseFunctionNonPositional list = - match tree with - | ParseTree.PositionalLeaf (_, teq) -> exFalso teq - | ParseTree.BranchPos (_, _, _, _, teq) -> exFalso teq - | ParseTree.NonPositionalLeaf (pf, _) -> [ pf ] - | ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) - - /// Returns the positional arg separately. - let rec accumulatorsPos - (tree : ParseTree) - : ParseFunctionNonPositional list * ParseFunctionPositional - = - match tree with - | ParseTree.PositionalLeaf (pf, _) -> [], pf - | ParseTree.NonPositionalLeaf (_, teq) -> exFalso' teq - | ParseTree.Branch (_, _, teq) -> exFalso' teq - | ParseTree.BranchPos (_, tree, trees, _, _) -> - let nonPos = trees |> List.collect (snd >> accumulatorsNonPos) - - let nonPos2, pos = accumulatorsPos tree - nonPos @ nonPos2, pos - - /// Collect all the ParseFunctions which are necessary to define variables, throwing away - /// all information relevant to composing the resulting variables into records. - /// Returns the list of non-positional parsers, and any positional parser that exists. - let accumulators<'a> (tree : ParseTree<'a>) : ParseFunctionNonPositional list * ParseFunctionPositional option = - // Sad duplication of some code here, but it was the easiest way to make it type-safe :( - match tree with - | ParseTree.PositionalLeaf (pf, _) -> [], Some pf - | ParseTree.NonPositionalLeaf (pf, _) -> [ pf ], None - | ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) |> (fun i -> i, None) - | ParseTree.BranchPos (_, tree, trees, _, _) -> - let nonPos = trees |> List.collect (snd >> accumulatorsNonPos) - - let nonPos2, pos = accumulatorsPos tree - nonPos @ nonPos2, Some pos - - |> fun (nonPos, pos) -> - let duplicateArgs = - // This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings. - Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm) - |> Seq.concat - |> Seq.choose (fun expr -> - match expr |> SynExpr.stripOptionalParen with - | SynExpr.Const (SynConst.String (s, _, _), _) -> Some s - | _ -> None - ) - |> List.ofSeq - |> List.groupBy id - |> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None) - - match duplicateArgs with - | [] -> nonPos, pos - | dups -> - let dups = dups |> String.concat " " - failwith $"Duplicate args detected! %s{dups}" - /// Build the return value. let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr = match tree with diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index bb0355a5..521c1dc5 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1,10 +1,12 @@ namespace WoofWare.Myriad.Plugins open System +open System.Collections.Generic open System.Text open Fantomas.FCS.Syntax open Fantomas.FCS.Text.Range open TypeEquality +open WoofWare.Myriad.Plugins open WoofWare.Whippet.Fantomas type internal ArgParserOutputSpec = @@ -31,19 +33,19 @@ type internal FlagDu = /// 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 = +type internal ArgumentDefaultSpec = /// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever). | EnvironmentVariable of name : SynExpr /// From calling the static member `{typeWeParseInto}.Default{name}()` /// For example, if `type MyArgs = { Thing : Choice }`, then /// we would use `MyArgs.DefaultThing () : int`. - /// | FunctionCall of name : Ident -type private Accumulation<'choice> = +type internal Accumulation<'choice> = | Required | Optional | Choice of 'choice + | ChoicePositional of attrContents : SynExpr option | List of Accumulation<'choice> type private ParseFunction<'acc> = @@ -85,8 +87,7 @@ type private ParseFunction<'acc> = module internal ShibaGenerator = - open SynTypePatterns - + //let log (s : string) = System.IO.File.AppendAllText ("/tmp/myriad.log", s + "\n") type RecognisedType = | Union of UnionType | Record of RecordType @@ -107,14 +108,40 @@ module internal ShibaGenerator = ) | _ -> None + /// Convert e.g. "Foo" into "--foo". + let argify (ident : Ident) : string = + let result = StringBuilder () + + for c in ident.idText do + if Char.IsUpper c then + result.Append('-').Append (Char.ToLowerInvariant c) |> ignore + else + result.Append c |> ignore + + result.ToString().TrimStart '-' + + type LeafData<'choice> = + { + /// Call this function to turn the input into the `TypeAfterParse`. + /// For example, `--foo=3` would have TypeAfterParse of `int`, and + /// `ParseFn` would be a function `string -> int`. + ParseFn : SynExpr + /// The type of this field, as it will appear in the final user's record. + TypeAfterParse : SynType + /// Essentially, how many times this leaf is expected to appear. + Acc : Accumulation<'choice> + /// `None` if not positional. `Some None` if positional and the PositionalArgs attribute had no contents. + /// `Some Some` if the PositionalArgs attribute had an argument. + Positional : SynExpr option option + } + type private ParseFunctionSpec<'choice> = - /// A leaf node, e.g. `--foo=3`. Call the `parseFn` to turn the input `"3"` into the `typeAfterParse` (here, `int`). - /// `Accumulation` represents essentially how many times this leaf is expected to be called. - | Leaf of parseFn : SynExpr * acc : Accumulation<'choice> * typeAfterParse : SynType + /// A leaf node, e.g. `--foo=3`. + | Leaf of LeafData<'choice> /// An opaque node we didn't recognise: e.g. `Foo : SomeType`. /// We're probably going to stamp out an "in-progress" type for this node. /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) - | UserDefined + | UserDefined of isRecord : bool * typeName : Ident /// An optional opaque node we didn't recognise: e.g. `Foo : SomeType option`. /// We're probably going to stamp out an "in-progress" type for this node. /// (Either that, or it's just a type we don't recognise, and then compilation will fail.) @@ -127,36 +154,58 @@ module internal ShibaGenerator = let rec private createParseFunction<'choice> (choice : ArgumentDefaultSpec option -> 'choice) (flagDus : FlagDu list) + (userDefinedRecordTypesWithParser : IEnumerable) + (userDefinedUnionTypesWithParser : IEnumerable) (fieldName : Ident) (attrs : SynAttribute list) (ty : SynType) : ParseFunctionSpec<'choice> = + let positional = + attrs + |> List.tryPick (fun a -> + match (List.last a.TypeName.LongIdent).idText with + | "PositionalArgsAttribute" + | "PositionalArgs" -> + match a.ArgExpr with + | SynExpr.Const (SynConst.Unit, _) -> Some None + | a -> Some (Some a) + | _ -> None + ) + match ty with | String -> - ParseFunctionSpec.Leaf ( - SynExpr.createLambda "x" (SynExpr.createIdent "x"), - Accumulation.Required, - SynType.string - ) + { + ParseFn = SynExpr.createLambda "x" (SynExpr.createIdent "x") + Acc = Accumulation.Required + TypeAfterParse = SynType.string + Positional = positional + } + |> ParseFunctionSpec.Leaf | PrimitiveType pt -> - ParseFunctionSpec.Leaf ( - SynExpr.createLambda - "x" - (SynExpr.applyFunction - (SynExpr.createLongIdent' (pt @ [ Ident.create "Parse" ])) - (SynExpr.createIdent "x")), - Accumulation.Required, - ty - ) + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent' (pt @ [ Ident.create "Parse" ])) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf | Uri -> - ParseFunctionSpec.Leaf ( - SynExpr.createLambda - "x" - (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Uri" ]) (SynExpr.createIdent "x")), - Accumulation.Required, - ty - ) + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Uri" ]) (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf | TimeSpan -> let parseExact = attrs @@ -210,41 +259,67 @@ module internal ShibaGenerator = |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "TimeSpan" ; "ParseExact" ]) |> SynExpr.createLambda "x" - ParseFunctionSpec.Leaf (parser, Accumulation.Required, ty) + { + ParseFn = parser + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf | FileInfo -> - ParseFunctionSpec.Leaf ( - SynExpr.createLambda - "x" - (SynExpr.applyFunction - (SynExpr.createLongIdent [ "System" ; "IO" ; "FileInfo" ]) - (SynExpr.createIdent "x")), - Accumulation.Required, - ty - ) + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "FileInfo" ]) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf | DirectoryInfo -> - ParseFunctionSpec.Leaf ( - SynExpr.createLambda - "x" - (SynExpr.applyFunction - (SynExpr.createLongIdent [ "System" ; "IO" ; "DirectoryInfo" ]) - (SynExpr.createIdent "x")), - Accumulation.Required, - ty - ) + { + ParseFn = + SynExpr.createLambda + "x" + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "IO" ; "DirectoryInfo" ]) + (SynExpr.createIdent "x")) + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf | OptionType eltTy -> - match createParseFunction choice flagDus fieldName attrs eltTy with - | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> - match acc with + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + eltTy + with + | ParseFunctionSpec.Leaf data -> + match data.Acc with | Accumulation.Optional -> failwith $"ArgParser does not support optionals containing options at field %s{fieldName.idText}: %O{ty}" + | Accumulation.ChoicePositional _ | Accumulation.Choice _ -> failwith $"ArgParser does not support optionals containing choices at field %s{fieldName.idText}: %O{ty}" | Accumulation.List _ -> failwith $"ArgParser does not support optional lists at field %s{fieldName.idText}: %O{ty}" - | Accumulation.Required -> ParseFunctionSpec.Leaf (parseElt, Accumulation.Optional, childTy) - | ParseFunctionSpec.UserDefined -> ParseFunctionSpec.OptionOfUserDefined + | Accumulation.Required -> + ParseFunctionSpec.Leaf + { data with + Acc = Accumulation.Optional + } + | ParseFunctionSpec.UserDefined _ -> ParseFunctionSpec.OptionOfUserDefined | ParseFunctionSpec.OptionOfUserDefined -> failwith $"ArgParser does not support lists of options at field %s{fieldName.idText}" | ChoiceType elts -> @@ -254,15 +329,25 @@ module internal ShibaGenerator = failwith $"ArgParser was unable to prove types %O{elt1} and %O{elt2} to be equal in a Choice. We require them to be equal." - match createParseFunction choice flagDus fieldName attrs elt1 with - | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> - match acc with + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + elt1 + with + | ParseFunctionSpec.Leaf data -> + match data.Acc with | Accumulation.Optional -> failwith $"ArgParser does not support choices containing options at field %s{fieldName.idText}: %O{ty}" | Accumulation.List _ -> failwith $"ArgParser does not support choices containing lists at field %s{fieldName.idText}: %O{ty}" + | Accumulation.ChoicePositional _ | Accumulation.Choice _ -> failwith $"ArgParser does not support choices containing choices at field %s{fieldName.idText}: %O{ty}" @@ -305,7 +390,17 @@ module internal ShibaGenerator = failwith $"Expected Choice to be annotated with at most one ArgumentDefaultFunction or similar, but it was annotated with multiple. Field: %s{fieldName.idText}" - ParseFunctionSpec.Leaf (parseElt, Accumulation.Choice (choice relevantAttr), childTy) + match positional with + | Some positional -> + ParseFunctionSpec.Leaf + { data with + Acc = Accumulation.ChoicePositional positional + } + | None -> + ParseFunctionSpec.Leaf + { data with + Acc = Accumulation.Choice (choice relevantAttr) + } | _ -> failwith $"Choices are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString elt1}" @@ -315,15 +410,41 @@ module internal ShibaGenerator = failwith $"ArgParser requires Choice to be of the form Choice<'a, 'a>; that is, two arguments, both the same. For field %s{fieldName.idText}, got: %s{elts}" | ListType eltTy -> - match createParseFunction choice flagDus fieldName attrs eltTy with - | ParseFunctionSpec.Leaf (parseElt, acc, childTy) -> - ParseFunctionSpec.Leaf (parseElt, Accumulation.List acc, childTy) + match + createParseFunction + choice + flagDus + userDefinedRecordTypesWithParser + userDefinedUnionTypesWithParser + fieldName + attrs + eltTy + with + | ParseFunctionSpec.Leaf data -> + ParseFunctionSpec.Leaf + { data with + Acc = Accumulation.List data.Acc + } | _ -> failwith $"Lists are only allowed to contain leaves; at %s{fieldName.idText}, got type %s{SynType.toHumanReadableString eltTy}" | ty -> match identifyAsFlag flagDus ty with - | None -> ParseFunctionSpec.UserDefined + | None -> + match ty with + | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> + let typeName = List.last id + + if Seq.contains typeName.idText userDefinedRecordTypesWithParser then + ParseFunctionSpec.UserDefined (true, typeName) + elif Seq.contains (List.last id).idText userDefinedUnionTypesWithParser then + ParseFunctionSpec.UserDefined (false, typeName) + else + failwith + $"we did not recognise the type %s{SynType.toHumanReadableString ty} as something we could build a parser for" + | _ -> + failwith + $"we did not recognise the type %s{SynType.toHumanReadableString ty} as something we could build a parser for" | Some flagDu -> // Parse as a bool, and then do the `if-then` dance. let parser = @@ -332,12 +453,473 @@ module internal ShibaGenerator = |> FlagDu.FromBoolean flagDu |> SynExpr.createLambda "x" - ParseFunctionSpec.Leaf (parser, Accumulation.Required, ty) + { + ParseFn = parser + Acc = Accumulation.Required + TypeAfterParse = ty + Positional = positional + } + |> ParseFunctionSpec.Leaf + + type internal DatalessUnion = + { + Cases : (string * SynAttribute list) list + } + + type internal ParsedRecordStructure<'choice> = + { + Original : RecordType + /// Map of field name to parser for that field + LeafNodes : Map> + Records : Map> + Unions : Map> + } + + and internal ParsedUnionStructure<'choice> = + { + Original : UnionType + Cases : Map> + } + + /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". + let private inProgressRecordType (record : ParsedRecordStructure<'choice>) : RecordType = + let leafFields = + record.LeafNodes + |> Map.toSeq + |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.toList + + let unionFields = + record.Unions + |> Map.toSeq + |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.toList + + let recordFields = + record.Records + |> Map.toSeq + |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.toList + + let fields = + leafFields @ unionFields @ recordFields + |> fun l -> + if l.IsEmpty then + { + Attrs = [] + Ident = Some (Ident.create "_Dummy") + Type = SynType.unit + } + |> SynField.make + |> List.singleton + else + l |> List.map (SynField.withMutability true) + + let members = + // for each field `FieldName` in order, we've made a variable `arg%i` + // which has done the optionality check + let instantiation = + record.Original.Fields + |> List.mapi (fun i (SynField.SynField (idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Original.Name.idText} to have a name, but it did not" + | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" + ) + |> SynExpr.createRecord None + |> SynExpr.applyFunction (SynExpr.createIdent "Ok") + + let defaultOf = + SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) + + let assignVariables = + record.Original.Fields + |> List.mapi (fun i f -> (i, f)) + |> List.collect (fun (i, SynField.SynField (attributes = attrs ; fieldType = ty ; idOpt = ident)) -> + match ident with + | None -> + failwith + $"expected field in record %s{record.Original.Name.idText} to have a name, but it did not" + | Some ident -> + + let valueForThisVar = + match record.Records |> Map.tryFind ident.idText with + | Some subRecord -> + // This was a record; defer to its parser. + // TODO: need to know if it has positionals + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Ok" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.createIdent "result") + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Error" ] + (SynArgPats.create [ SynPat.named "err" ])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "AddRange" + (SynExpr.createIdent "errors") + (SynExpr.createIdent "err") + defaultOf + ]) + ] + |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + | None -> + + match record.Unions |> Map.tryFind ident.idText with + | Some union -> + // This was a union; defer to its parser. + failwith "TODO" + | None -> + + match record.LeafNodes |> Map.tryFind ident.idText with + | Some leaf -> + match leaf.Positional with + | Some pos -> + // Positional args carried in from external argument. + // TODO: register whether they came before or after separator + SynExpr.createIdent "positionals" + | None -> + + let extract = + match leaf.TypeAfterParse with + | ChoiceType [ _ ; _ ] -> + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.applyFunction + (SynExpr.createIdent "Choice1Of2") + (SynExpr.createIdent "result")) + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (SynExpr.CreateConst "TODO" + |> SynExpr.applyFunction (SynExpr.createIdent "Choice2Of2")) + ] + |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + | ListType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | PrimitiveType _ -> + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.create [ SynPat.named "result" ])) + (SynExpr.createIdent "result") + SynMatchClause.create + (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "Add" + (SynExpr.CreateConst $"no value provided for %s{ident.idText}") + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + | OptionType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | ty -> failwith $"Could not convert type %s{SynType.toHumanReadableString ty}" + + extract + | None -> + failwith + $"somehow we never classified the field %s{ident.idText} of %s{record.Original.Name.idText}" + + valueForThisVar + |> SynBinding.basic [ Ident.create $"arg%i{i}" ] [] + |> SynBinding.withReturnAnnotation ty + |> List.singleton + ) + + SynExpr.ifThenElse + (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) + (SynExpr.createIdent "errors" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + instantiation + |> SynExpr.createLet assignVariables + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors" ] + [] + (SynExpr.applyFunction + (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) + (SynExpr.CreateConst ())) + ] + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble" ] + [ + SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app + "Result" + [ + SynType.createLongIdent [ record.Original.Name ] + SynType.list SynType.string + ] + ) + + { + Name = record.Original.Name.idText + "_InProgress" |> Ident.create + Fields = fields + Members = members |> SynMemberDefn.memberImplementation |> List.singleton |> Some + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some + Generics = + match record.Original.Generics with + | None -> None + | Some _ -> + failwith $"Record type %s{record.Original.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Private range0) + ImplAccessibility = None + Attributes = [] + } + + type internal AllInfo = + { + /// Map of identifier to parser + RecordParsers : IReadOnlyDictionary> + /// Map of identifier to parser + UnionParsers : IReadOnlyDictionary> + /// Map of identifier to DU information + FlagDus : Map + /// Map of identifier to DU information + DatalessUnions : Map + } + + /// Returns None if we haven't yet obtained parse structures for the dependencies of this record. + let private parseRecord + (knownRecordParserTypes : IReadOnlyDictionary>) + (knownUnionParserTypes : IReadOnlyDictionary>) + (flagDus : FlagDu list) + (rt : RecordType) + : ParsedRecordStructure option + = + let getChoice (spec : ArgumentDefaultSpec option) : ArgumentDefaultSpec = + match spec with + | None -> + failwith + $"Non-positional Choice args must have an `[]` attribute on them, in record {rt.Name.idText}." + | Some spec -> spec + + let aggregated = + (Some ([], [], []), rt.Fields) + ||> List.fold (fun aggr (SynField.SynField (idOpt = ident ; attributes = attrs ; fieldType = ty)) -> + match aggr with + | None -> None + | Some (leaf, records, unions) -> + + match ident with + | None -> + failwith + $"expected all fields on record type %s{rt.Name.idText} to have a name, but at least one did not" + | Some ident -> + + let spec = + createParseFunction + getChoice + flagDus + knownRecordParserTypes.Keys + knownUnionParserTypes.Keys + ident + (SynAttributes.toAttrs attrs) + ty + + match spec with + | Leaf data -> ((ident.idText, data) :: leaf, records, unions) |> Some + | UserDefined (isRecord, typeName) -> + if isRecord then + match knownRecordParserTypes.TryGetValue typeName.idText with + | false, _ -> None + | true, v -> (leaf, (ident.idText, v) :: records, unions) |> Some + else + match knownUnionParserTypes.TryGetValue typeName.idText with + | false, _ -> None + | true, v -> (leaf, records, (ident.idText, v) :: unions) |> Some + | OptionOfUserDefined -> failwith "todo" + ) + + match aggregated with + | None -> None + | Some (leaf, records, unions) -> + { + Original = rt + LeafNodes = leaf |> Map.ofList + Records = records |> Map.ofList + Unions = unions |> Map.ofList + } + |> Some + + /// Returns None if we haven't yet obtained parse structures for the dependencies of this union. + /// This function already knows that it's a parser: that is, every case has exactly one field. + /// It doesn't necessarily know that those fields can be parsed as records. + let private parseUnion + (knownRecordTypes : IReadOnlyDictionary>) + (ut : UnionType) + : ParsedUnionStructure option + = + ut.Cases + |> List.map (fun case -> + let field = + match case.Fields with + | [ x ] -> x + | [] -> + failwith + $"Logic error: expected case %s{case.Name.idText} to have exactly one field, but it had none" + | _ -> + failwith + $"Logic error: expected case %s{case.Name.idText} to have exactly one field, but it had more than one" + + match field.Type with + | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> + match knownRecordTypes.TryGetValue (List.last id).idText with + | false, _ -> None + | true, v -> Some (case.Name.idText, v) + | _ -> + failwith + "ArgParser generator requires discriminated union cases to each contain exactly one field which is a record type, to hold their data." + ) + |> List.allSome + |> Option.map Map.ofList + |> Option.map (fun x -> + { + Original = ut + Cases = x + } + ) + + let internal parseStructureWithinNs (unions : UnionType list) (records : RecordType list) : AllInfo = + let flagDus, datalessUnions, parserUnions = + (([], [], []), unions) + ||> List.fold (fun (flagDus, datalessUnions, unions) union -> + match union.Cases |> List.tryFind (fun case -> not case.Fields.IsEmpty) with + | Some dataCarryingCase -> + match union.Cases |> List.tryFind (fun case -> case.Fields.Length <> 1) with + | Some badCase -> + failwith + $"Unions must either be dataless or every field must have exactly one member. Type %s{union.Name.idText} has case %s{dataCarryingCase.Name.idText} with data, but case %s{badCase.Name.idText} doesn't have exactly one field." + | None -> + // OK, all cases have exactly one field. + flagDus, datalessUnions, union :: unions + | None -> + + let datalessUnionBranch () = + let datalessUnion = + { + DatalessUnion.Cases = + union.Cases |> List.map (fun case -> case.Name.idText, case.Attributes) + } + + flagDus, (union.Name.idText, datalessUnion) :: datalessUnions, unions + + // dataless or flag + match union.Cases with + | [ c1 ; c2 ] -> + let c1Attr = + c1.Attributes + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (id, _, _) -> + match id |> List.last |> _.idText with + | "ArgumentFlagAttribute" + | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr) + | _ -> None + ) + + let c2Attr = + c2.Attributes + |> List.tryPick (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (id, _, _) -> + match id |> List.last |> _.idText with + | "ArgumentFlagAttribute" + | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr) + | _ -> None + ) + + match c1Attr, c2Attr with + | Some _, None + | None, Some _ -> + failwith + "[] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case." + | None, None -> + // actually a dataless union + datalessUnionBranch () + | Some c1Attr, Some c2Attr -> + + // Sanity check where possible + match c1Attr, c2Attr with + | SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) -> + if b1 = b2 then + failwith + "[] must have opposite argument values on each case in a two-case discriminated union." + | _, _ -> () + + match c1.Fields, c2.Fields with + | [], [] -> + let flagDu = + { + Name = union.Name + Case1Name = c1.Name + Case1Arg = c1Attr + Case2Name = c2.Name + Case2Arg = c2Attr + } + + (union.Name.idText, flagDu) :: flagDus, datalessUnions, unions + | _, _ -> + failwith "[] may only be placed on discriminated union members with no data." + | _ -> datalessUnionBranch () + ) + + let allKnownUnionTypes = Dictionary () + let allKnownRecordTypes = Dictionary () + + let mutable keepLooping = true + + while keepLooping do + keepLooping <- false + let mutable madeAChange = false + + for record in records do + if not (allKnownRecordTypes.ContainsKey record.Name.idText) then + match parseRecord allKnownRecordTypes allKnownUnionTypes (flagDus |> List.map snd) record with + | None -> keepLooping <- true + | Some v -> + allKnownRecordTypes.Add (record.Name.idText, v) + madeAChange <- true + + for union in parserUnions do + match parseUnion allKnownRecordTypes union with + | None -> keepLooping <- true + | Some v -> + allKnownUnionTypes.Add (union.Name.idText, v) + madeAChange <- true + + if not madeAChange then + let knownRecords = allKnownRecordTypes.Keys |> String.concat "," + let knownUnions = allKnownUnionTypes.Keys |> String.concat "," + + failwith + $"Cyclic dependency detected which we can't break. Known records:\n%s{knownRecords}\nKnown unions:\n%s{knownUnions}" + + { + RecordParsers = allKnownRecordTypes + UnionParsers = allKnownUnionTypes + FlagDus = Map.ofList flagDus + DatalessUnions = Map.ofList datalessUnions + } /// 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) + (flagDuNames : string ICollection) (allKnownTypeIdents : string list) (ty : RecognisedType) : RecordType option @@ -347,7 +929,7 @@ module internal ShibaGenerator = // TODO: this is super jank let ident = List.last ty - if List.contains ident.idText flagDuNames then + if flagDuNames.Contains ident.idText then // Flag DUs have no in-progress form as such SynType.createLongIdent ty |> SynType.option elif List.contains ident.idText allKnownTypeIdents then @@ -467,7 +1049,7 @@ module internal ShibaGenerator = } ] else - l + l |> List.map (SynField.withMutability true) Generics = match union.Generics with | None -> None @@ -490,16 +1072,15 @@ module internal ShibaGenerator = ) |> fun l -> if l.IsEmpty then - [ - SynField.make - { - Attrs = [] - Ident = Some (Ident.create "_Dummy") - Type = SynType.unit - } - ] + { + Attrs = [] + Ident = Some (Ident.create "_Dummy") + Type = SynType.unit + } + |> SynField.make + |> List.singleton else - l + l |> List.map (SynField.withMutability true) Members = // for each field `FieldName` in order, we've made a variable `arg%i` // which has done the optionality check @@ -660,71 +1241,7 @@ module internal ShibaGenerator = } |> 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 createHelpersModule (opens : SynOpenDeclTarget list) (ns : LongIdent) (info : AllInfo) : SynModuleDecl = let modName = let ns = ns |> List.map _.idText |> String.concat "_" Ident.create $"ArgParseHelpers_%s{ns}" @@ -734,28 +1251,17 @@ module internal ShibaGenerator = |> 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 flagDuNames = info.FlagDus.Keys 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 - ) + info.RecordParsers + |> Seq.map (fun (KeyValue (_, record)) -> inProgressRecordType record |> RecordType.ToAst) + |> Seq.toList 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 - ) + info.UnionParsers + |> Seq.map (fun (KeyValue (_, union)) -> failwith "TODO") + |> Seq.toList let taggedMod = [ @@ -904,12 +1410,17 @@ open Myriad.Core /// Myriad generator that provides a catamorphism for an algebraic data type. [] -type ArgParserGenerator () = +type ShibaGenerator () = interface IMyriadGenerator with member _.ValidInputExtensions = [ ".fs" ] member _.Generate (context : GeneratorContext) = + // try + // System.IO.File.Delete "/tmp/myriad.log" + // with + // | _ -> () + let ast, _ = Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head @@ -961,7 +1472,7 @@ type ArgParserGenerator () = if not others.IsEmpty then failwith - $"Error: all types recursively defined together with an ArgParserGenerator type must be discriminated unions or records. %+A{others}" + $"Error: all types recursively defined together with a ShibaGenerator type must be discriminated unions or records. %+A{others}" (ns, taggedType, unions, records) ) @@ -982,18 +1493,15 @@ type ArgParserGenerator () = ) ) - let helpersMod = + let structuresWithinNs = unionsAndRecordsByNs + |> Map.map (fun _ (us, rs) -> ShibaGenerator.parseStructureWithinNs us rs) + + let helpersMod = + structuresWithinNs |> 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.map (fun (ns, info) -> + ShibaGenerator.createHelpersModule opens (ns.Split '.' |> Seq.map Ident.create |> List.ofSeq) info ) |> Seq.toList |> fun l -> [ yield! l ] diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index da03107f..468a892e 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -22,7 +22,7 @@ - + @@ -40,8 +40,8 @@ - + From 67eb89cfc0ba966a114f31ae415af31a44e0d792 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Mon, 14 Apr 2025 22:27:57 +0100 Subject: [PATCH 06/26] Getting there --- ConsumePlugin/GeneratedArgs.fs | 438 ++++++++++++++------ WoofWare.Myriad.Plugins/ShibaGenerator.fs | 471 ++++++---------------- 2 files changed, 440 insertions(+), 469 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 2cfb5b68..c3decc8c 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -20,13 +20,17 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed BasicNoPositionals. type private BasicNoPositionals_InProgress = { - mutable Foo : System.Int32 option - mutable Bar : System.String option - mutable Baz : System.Boolean option - mutable Rest : string list + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -50,7 +54,7 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for Baz" Unchecked.defaultof<_> - let arg3 : int list = this.Rest + let arg3 : int list = this.Rest |> Seq.toList if errors.Count = 0 then Ok @@ -66,12 +70,17 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed Basic. type private Basic_InProgress = { - mutable Foo : System.Int32 option - mutable Bar : System.String option - mutable Baz : System.Boolean option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -95,8 +104,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for Baz" Unchecked.defaultof<_> - let arg3 : string list = positionals - let positionals = () + let arg3 : string list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> x) if errors.Count = 0 then Ok @@ -112,12 +127,17 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed BasicWithIntPositionals. type private BasicWithIntPositionals_InProgress = { - mutable Foo : System.Int32 option - mutable Bar : System.String option - mutable Baz : System.Boolean option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable Rest : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -141,8 +161,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for Baz" Unchecked.defaultof<_> - let arg3 : int list = positionals - let positionals = () + let arg3 : int list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> System.Int32.Parse x) if errors.Count = 0 then Ok @@ -158,19 +184,24 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed LoadsOfTypes. type private LoadsOfTypes_InProgress = { - mutable Foo : System.Int32 option - mutable Bar : System.String option - mutable Baz : System.Boolean option - mutable SomeFile : FileInfo option - mutable SomeDirectory : DirectoryInfo option - mutable SomeList : string list - mutable OptionalThingWithNoDefault : int option - mutable OptionalThing : bool option mutable AnotherOptionalThing : int option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable OptionalThing : bool option + mutable OptionalThingWithNoDefault : int option + mutable Positionals : ResizeArray + mutable SomeDirectory : DirectoryInfo option + mutable SomeFile : FileInfo option + mutable SomeList : ResizeArray mutable YetAnotherOptionalThing : string option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -196,37 +227,44 @@ module private ArgParseHelpers_ConsumePlugin = let arg3 : FileInfo = match this.SomeFile with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for SomeFile" Unchecked.defaultof<_> let arg4 : DirectoryInfo = match this.SomeDirectory with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for SomeDirectory" Unchecked.defaultof<_> - let arg5 : DirectoryInfo list = this.SomeList + let arg5 : DirectoryInfo list = this.SomeList |> Seq.toList let arg6 : int option = this.OptionalThingWithNoDefault - let arg7 : int list = positionals - let positionals = () + + let arg7 : int list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> System.Int32.Parse x) let arg8 : Choice = match this.OptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 (LoadsOfTypes.DefaultOptionalThing ()) let arg9 : Choice = match this.AnotherOptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 (LoadsOfTypes.DefaultAnotherOptionalThing ()) let arg10 : Choice = match this.YetAnotherOptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) if errors.Count = 0 then Ok @@ -249,19 +287,23 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed LoadsOfTypesNoPositionals. type private LoadsOfTypesNoPositionals_InProgress = { - mutable Foo : System.Int32 option - mutable Bar : System.String option - mutable Baz : System.Boolean option - mutable SomeFile : FileInfo option - mutable SomeDirectory : DirectoryInfo option - mutable SomeList : string list - mutable OptionalThingWithNoDefault : int option - mutable OptionalThing : bool option mutable AnotherOptionalThing : int option + mutable Bar : string option + mutable Baz : bool option + mutable Foo : int option + mutable OptionalThing : bool option + mutable OptionalThingWithNoDefault : int option + mutable SomeDirectory : DirectoryInfo option + mutable SomeFile : FileInfo option + mutable SomeList : ResizeArray mutable YetAnotherOptionalThing : string option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -287,35 +329,35 @@ module private ArgParseHelpers_ConsumePlugin = let arg3 : FileInfo = match this.SomeFile with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for SomeFile" Unchecked.defaultof<_> let arg4 : DirectoryInfo = match this.SomeDirectory with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for SomeDirectory" Unchecked.defaultof<_> - let arg5 : DirectoryInfo list = this.SomeList + let arg5 : DirectoryInfo list = this.SomeList |> Seq.toList let arg6 : int option = this.OptionalThingWithNoDefault let arg7 : Choice = match this.OptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 (LoadsOfTypesNoPositionals.DefaultOptionalThing ()) let arg8 : Choice = match this.AnotherOptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 (LoadsOfTypesNoPositionals.DefaultAnotherOptionalThing ()) let arg9 : Choice = match this.YetAnotherOptionalThing with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) if errors.Count = 0 then Ok @@ -337,41 +379,45 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed DatesAndTimes. type private DatesAndTimes_InProgress = { - mutable Plain : TimeSpan option - mutable Invariant : TimeSpan option mutable Exact : TimeSpan option + mutable Invariant : TimeSpan option mutable InvariantExact : TimeSpan option + mutable Plain : TimeSpan option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : TimeSpan = match this.Plain with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for Plain" Unchecked.defaultof<_> let arg1 : TimeSpan = match this.Invariant with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for Invariant" Unchecked.defaultof<_> let arg2 : TimeSpan = match this.Exact with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for Exact" Unchecked.defaultof<_> let arg3 : TimeSpan = match this.InvariantExact with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for InvariantExact" Unchecked.defaultof<_> if errors.Count = 0 then @@ -388,11 +434,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChildRecord. type private ChildRecord_InProgress = { - mutable Thing1 : System.Int32 option - mutable Thing2 : System.String option + mutable Thing1 : int option + mutable Thing2 : string option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -421,18 +471,22 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecord. type private ParentRecord_InProgress = { + mutable AndAnother : bool option mutable Child : ChildRecord_InProgress - mutable AndAnother : System.Boolean option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : ChildRecord = - match this.Child with + match this.Child.Assemble getEnvironmentVariable positionals with | Ok result -> result | Error err -> - err.AddRange errors + errors.AddRange err Unchecked.defaultof<_> let arg1 : bool = @@ -454,10 +508,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChildRecordWithPositional. type private ChildRecordWithPositional_InProgress = { - mutable Thing1 : System.Int32 option + mutable Thing1 : int option + mutable Thing2 : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : int = @@ -467,8 +526,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for Thing1" Unchecked.defaultof<_> - let arg1 : Uri list = positionals - let positionals = () + let arg1 : Uri list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> System.Uri x) if errors.Count = 0 then Ok @@ -482,18 +547,22 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecordChildPos. type private ParentRecordChildPos_InProgress = { + mutable AndAnother : bool option mutable Child : ChildRecordWithPositional_InProgress - mutable AndAnother : System.Boolean option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : ChildRecordWithPositional = - match this.Child with + match this.Child.Assemble getEnvironmentVariable positionals with | Ok result -> result | Error err -> - err.AddRange errors + errors.AddRange err Unchecked.defaultof<_> let arg1 : bool = @@ -515,21 +584,32 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecordSelfPos. type private ParentRecordSelfPos_InProgress = { + mutable AndAnother : ResizeArray mutable Child : ChildRecord_InProgress } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : ChildRecord = - match this.Child with + match this.Child.Assemble getEnvironmentVariable positionals with | Ok result -> result | Error err -> - err.AddRange errors + errors.AddRange err Unchecked.defaultof<_> - let arg1 : bool list = positionals - let positionals = () + let arg1 : bool list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> System.Boolean.Parse x) if errors.Count = 0 then Ok @@ -543,13 +623,23 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChoicePositionals. type private ChoicePositionals_InProgress = { - _Dummy : unit + mutable Args : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () - let arg0 : Choice list = positionals - let positionals = () + + let arg0 : Choice list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 x -> (fun x -> x) x |> Choice2Of2 + ) if errors.Count = 0 then Ok @@ -565,13 +655,22 @@ module private ArgParseHelpers_ConsumePlugin = mutable BoolVar : bool option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : Choice = match this.BoolVar with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> + Choice2Of2 ( + "CONSUMEPLUGIN_THINGS" + |> getEnvironmentVariable + |> (fun x -> System.Boolean.Parse x) + ) if errors.Count = 0 then Ok @@ -587,14 +686,18 @@ module private ArgParseHelpers_ConsumePlugin = mutable DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : DryRunMode = match this.DryRun with - | Ok result -> result - | Error err -> - err.AddRange errors + | Some result -> result + | None -> + errors.Add "no value provided for DryRun" Unchecked.defaultof<_> if errors.Count = 0 then @@ -611,13 +714,27 @@ module private ArgParseHelpers_ConsumePlugin = mutable DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : Choice = match this.DryRun with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> + Choice2Of2 ( + "CONSUMEPLUGIN_THINGS" + |> getEnvironmentVariable + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + ) if errors.Count = 0 then Ok @@ -633,13 +750,17 @@ module private ArgParseHelpers_ConsumePlugin = mutable DryRun : DryRunMode option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : Choice = match this.DryRun with | Some result -> Choice1Of2 result - | None -> Choice2Of2 "TODO" + | None -> Choice2Of2 (ContainsFlagDefaultValue.DefaultDryRun ()) if errors.Count = 0 then Ok @@ -652,11 +773,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed ManyLongForms. type private ManyLongForms_InProgress = { - mutable DoTheThing : System.String option - mutable SomeFlag : System.Boolean option + mutable DoTheThing : string option + mutable SomeFlag : bool option } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -685,10 +810,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgs. type private FlagsIntoPositionalArgs_InProgress = { - mutable A : System.String option + mutable A : string option + mutable GrabEverything : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -698,8 +828,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for A" Unchecked.defaultof<_> - let arg1 : string list = positionals - let positionals = () + let arg1 : string list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> x) if errors.Count = 0 then Ok @@ -713,10 +849,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsChoice. type private FlagsIntoPositionalArgsChoice_InProgress = { - mutable A : System.String option + mutable A : string option + mutable GrabEverything : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -726,8 +867,13 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for A" Unchecked.defaultof<_> - let arg1 : Choice list = positionals - let positionals = () + let arg1 : Choice list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 x -> (fun x -> x) x |> Choice2Of2 + ) if errors.Count = 0 then Ok @@ -741,10 +887,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsInt. type private FlagsIntoPositionalArgsInt_InProgress = { - mutable A : System.String option + mutable A : string option + mutable GrabEverything : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -754,8 +905,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for A" Unchecked.defaultof<_> - let arg1 : int list = positionals - let positionals = () + let arg1 : int list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> System.Int32.Parse x) if errors.Count = 0 then Ok @@ -769,10 +926,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type private FlagsIntoPositionalArgsIntChoice_InProgress = { - mutable A : System.String option + mutable A : string option + mutable GrabEverything : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -782,8 +944,13 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for A" Unchecked.defaultof<_> - let arg1 : Choice list = positionals - let positionals = () + let arg1 : Choice list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> (fun x -> System.Int32.Parse x) x |> Choice1Of2 + | Choice2Of2 x -> (fun x -> System.Int32.Parse x) x |> Choice2Of2 + ) if errors.Count = 0 then Ok @@ -797,10 +964,15 @@ module private ArgParseHelpers_ConsumePlugin = /// A partially-parsed FlagsIntoPositionalArgs'. type private FlagsIntoPositionalArgs'_InProgress = { - mutable A : System.String option + mutable A : string option + mutable DontGrabEverything : ResizeArray } - member this.Assemble (positionals : string list) : Result = + member this.Assemble + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = let errors = ResizeArray () let arg0 : string = @@ -810,8 +982,14 @@ module private ArgParseHelpers_ConsumePlugin = errors.Add "no value provided for A" Unchecked.defaultof<_> - let arg1 : string list = positionals - let positionals = () + let arg1 : string list = + positionals + |> List.map (fun x -> + match x with + | Choice1Of2 x -> x + | Choice2Of2 x -> x + ) + |> List.map (fun x -> x) if errors.Count = 0 then Ok diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 521c1dc5..df4d5c6f 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -482,11 +482,28 @@ module internal ShibaGenerator = } /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". - let private inProgressRecordType (record : ParsedRecordStructure<'choice>) : RecordType = + let private inProgressRecordType (record : ParsedRecordStructure) : RecordType = let leafFields = record.LeafNodes |> Map.toSeq - |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.map (fun (ident, data) -> + match data.Acc with + | Accumulation.Choice choice -> SynType.option data.TypeAfterParse + | Accumulation.ChoicePositional choice -> failwith "TODO" + | Accumulation.List acc -> + SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ] + | Accumulation.Optional -> SynType.option data.TypeAfterParse + | Accumulation.Required -> SynType.option data.TypeAfterParse + + |> fun ty -> + { + Attrs = [] + Type = ty + Ident = Some (Ident.create ident) + } + |> SynField.make + |> SynField.withMutability true + ) |> Seq.toList let unionFields = @@ -498,7 +515,14 @@ module internal ShibaGenerator = let recordFields = record.Records |> Map.toSeq - |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.map (fun (ident, data) -> + { + Attrs = [] + Ident = Ident.create ident |> Some + Type = SynType.createLongIdent [ Ident.create $"%s{data.Original.Name.idText}_InProgress" ] + } + |> SynField.make + ) |> Seq.toList let fields = @@ -547,6 +571,11 @@ module internal ShibaGenerator = match record.Records |> Map.tryFind ident.idText with | Some subRecord -> // This was a record; defer to its parser. + let subAssembleCall = + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.callMethodArg "Assemble" (SynExpr.createIdent "getEnvironmentVariable") + |> SynExpr.applyTo (SynExpr.createIdent "positionals") + // TODO: need to know if it has positionals [ SynMatchClause.create @@ -562,12 +591,12 @@ module internal ShibaGenerator = [ SynExpr.callMethodArg "AddRange" - (SynExpr.createIdent "errors") (SynExpr.createIdent "err") + (SynExpr.createIdent "errors") defaultOf ]) ] - |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) + |> SynExpr.createMatch subAssembleCall | None -> match record.Unions |> Map.tryFind ident.idText with @@ -582,12 +611,82 @@ module internal ShibaGenerator = | Some pos -> // Positional args carried in from external argument. // TODO: register whether they came before or after separator - SynExpr.createIdent "positionals" + match leaf.Acc with + | List acc -> + match acc with + | Accumulation.List _ -> + failwith "unexpected: positional args should not be a list of lists" + | Accumulation.Required -> + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.createMatch + (SynExpr.createIdent "x") + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.createIdent "x") + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.createIdent "x") + ])) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "List" ; "map" ]) + leaf.ParseFn + ) + | Accumulation.Optional -> + failwith "unexpected: positional args should not be a list of options" + | Accumulation.Choice _ -> + failwith + "internal error: positional args, if Choicey, should be a ChoicePositional" + | Accumulation.ChoicePositional attrContents -> + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.createMatch + (SynExpr.createIdent "x") + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.applyFunction + leaf.ParseFn + (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction ( + SynExpr.createIdent "Choice1Of2" + )) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.createNamed [ "x" ])) + (SynExpr.applyFunction + leaf.ParseFn + (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction ( + SynExpr.createIdent "Choice2Of2" + )) + ])) + ) + | _ -> failwith "unexpected: positional arguments should be a list" | None -> let extract = - match leaf.TypeAfterParse with - | ChoiceType [ _ ; _ ] -> + match leaf.Acc with + | Accumulation.ChoicePositional choice -> failwith "TODO" + | Accumulation.Choice choice -> [ SynMatchClause.create (SynPat.identWithArgs @@ -598,12 +697,28 @@ module internal ShibaGenerator = (SynExpr.createIdent "result")) SynMatchClause.create (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) - (SynExpr.CreateConst "TODO" + (match choice with + | ArgumentDefaultSpec.EnvironmentVariable var -> + var + |> SynExpr.pipeThroughFunction ( + SynExpr.createIdent "getEnvironmentVariable" + ) + |> SynExpr.pipeThroughFunction leaf.ParseFn + | ArgumentDefaultSpec.FunctionCall name -> + SynExpr.callMethod + name.idText + (SynExpr.createIdent' record.Original.Name) + |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createIdent "Choice2Of2")) ] |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) - | ListType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - | PrimitiveType _ -> + | Accumulation.List acc -> + // TODO: use the acc here too?! + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + | Accumulation.Optional -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + | Accumulation.Required -> + // fall back to assuming it's basically primitive [ SynMatchClause.create (SynPat.identWithArgs @@ -622,8 +737,6 @@ module internal ShibaGenerator = ]) ] |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) - | OptionType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - | ty -> failwith $"Could not convert type %s{SynType.toHumanReadableString ty}" extract | None -> @@ -655,7 +768,12 @@ module internal ShibaGenerator = |> SynBinding.basic [ Ident.create "this" ; Ident.create "Assemble" ] [ - SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") + SynPat.annotateType + (SynType.funFromDomain SynType.string SynType.string) + (SynPat.named "getEnvironmentVariable") + SynPat.annotateType + (SynType.list (SynType.app "Choice" [ SynType.string ; SynType.string ])) + (SynPat.named "positionals") ] |> SynBinding.withReturnAnnotation ( SynType.app @@ -916,331 +1034,6 @@ module internal ShibaGenerator = DatalessUnions = Map.ofList datalessUnions } - /// 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 ICollection) - (allKnownTypeIdents : string list) - (ty : RecognisedType) - : RecordType option - = - /// Get the "in-progress type" corresponding to the type with this name. - let getInProgressTypeName (ty : LongIdent) : SynType = - // TODO: this is super jank - let ident = List.last ty - - if flagDuNames.Contains ident.idText 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.app "Result" [ SynType.createLongIdent [ union.Name ] ; SynType.list SynType.string ] - ) - |> 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 |> List.map (SynField.withMutability true) - 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 - { - Attrs = [] - Ident = Some (Ident.create "_Dummy") - Type = SynType.unit - } - |> SynField.make - |> List.singleton - else - l |> List.map (SynField.withMutability true) - Members = - // for each field `FieldName` in order, we've made a variable `arg%i` - // which has done the optionality check - let instantiation = - record.Fields - |> List.mapi (fun i (SynField.SynField (idOpt = ident)) -> - match ident with - | None -> - failwith - $"expected field in record %s{record.Name.idText} to have a name, but it did not" - | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" - ) - |> SynExpr.createRecord None - |> SynExpr.applyFunction (SynExpr.createIdent "Ok") - - let defaultOf = - SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) - - let assignVariables = - record.Fields - |> List.mapi (fun i f -> (i, f)) - |> List.collect (fun - (i, SynField.SynField (attributes = attrs ; fieldType = ty ; idOpt = ident)) -> - match ident with - | None -> - failwith - $"expected field in record %s{record.Name.idText} to have a name, but it did not" - | Some ident -> - // TODO: jank conditional - if - attrs - |> SynAttributes.toAttrs - |> List.exists (fun x -> - List.last(x.TypeName.LongIdent).idText.StartsWith "PositionalArgs" - ) - then - // Positional args carried in from external argument - [ - SynBinding.basic - [ Ident.create $"arg%i{i}" ] - [] - (SynExpr.createIdent "positionals") - |> SynBinding.withReturnAnnotation ty - // prevent further usages of positional args - SynBinding.basic [ Ident.create "positionals" ] [] (SynExpr.CreateConst ()) - ] - else - let extract = - match ty with - | ChoiceType [ _ ; _ ] -> - [ - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Some" ] - (SynArgPats.create [ SynPat.named "result" ])) - (SynExpr.applyFunction - (SynExpr.createIdent "Choice1Of2") - (SynExpr.createIdent "result")) - SynMatchClause.create - (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) - (SynExpr.CreateConst "TODO" - |> SynExpr.applyFunction (SynExpr.createIdent "Choice2Of2")) - ] - |> SynExpr.createMatch ( - SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - ) - | ListType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - | PrimitiveType _ -> - [ - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Some" ] - (SynArgPats.create [ SynPat.named "result" ])) - (SynExpr.createIdent "result") - SynMatchClause.create - (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) - (SynExpr.sequential - [ - SynExpr.callMethodArg - "Add" - (SynExpr.CreateConst - $"no value provided for %s{ident.idText}") - (SynExpr.createIdent "errors") - defaultOf - ]) - ] - |> SynExpr.createMatch ( - SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - ) - | OptionType _ -> SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - | SynType.LongIdent (SynLongIdent.SynLongIdent _) -> - // TODO: need to know if it has positionals - [ - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Ok" ] - (SynArgPats.create [ SynPat.named "result" ])) - (SynExpr.createIdent "result") - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Error" ] - (SynArgPats.create [ SynPat.named "err" ])) - (SynExpr.sequential - [ - SynExpr.callMethodArg - "AddRange" - (SynExpr.createIdent "errors") - (SynExpr.createIdent "err") - defaultOf - ]) - ] - |> SynExpr.createMatch ( - SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - ) - | ty -> failwith $"TODO: got type {ty} which we don't know how to handle" - - extract - |> SynBinding.basic [ Ident.create $"arg%i{i}" ] [] - |> SynBinding.withReturnAnnotation ty - |> List.singleton - ) - - SynExpr.ifThenElse - (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) - (SynExpr.createIdent "errors" - |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) - |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) - instantiation - |> SynExpr.createLet assignVariables - |> SynExpr.createLet - [ - SynBinding.basic - [ Ident.create "errors" ] - [] - (SynExpr.applyFunction - (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) - (SynExpr.CreateConst ())) - ] - |> SynBinding.basic - [ Ident.create "this" ; Ident.create "Assemble" ] - [ - SynPat.annotateType (SynType.list SynType.string) (SynPat.named "positionals") - ] - |> SynBinding.withReturnAnnotation ( - SynType.app "Result" [ SynType.createLongIdent [ record.Name ] ; SynType.list SynType.string ] - ) - |> 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) (info : AllInfo) : SynModuleDecl = let modName = let ns = ns |> List.map _.idText |> String.concat "_" From 963a09736042272d42a1ea686b2455c040d9b2c2 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Mon, 14 Apr 2025 22:52:18 +0100 Subject: [PATCH 07/26] First line of implementation --- ConsumePlugin/GeneratedArgs.fs | 315 ++++++++++++++++++---- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 114 +++++--- 2 files changed, 353 insertions(+), 76 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index c3decc8c..3f2563d5 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -11,14 +11,14 @@ namespace ArgParserHelpers /// Helper types for arg parsing -module private ArgParseHelpers_ConsumePlugin = +module internal ArgParseHelpers_ConsumePlugin = open System open System.IO open WoofWare.Myriad.Plugins open ConsumePlugin /// A partially-parsed BasicNoPositionals. - type private BasicNoPositionals_InProgress = + type internal BasicNoPositionals_InProgress = { mutable Bar : string option mutable Baz : bool option @@ -67,8 +67,16 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : BasicNoPositionals_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } + /// A partially-parsed Basic. - type private Basic_InProgress = + type internal Basic_InProgress = { mutable Bar : string option mutable Baz : bool option @@ -124,8 +132,16 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : Basic_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } + /// A partially-parsed BasicWithIntPositionals. - type private BasicWithIntPositionals_InProgress = + type internal BasicWithIntPositionals_InProgress = { mutable Bar : string option mutable Baz : bool option @@ -181,8 +197,16 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : BasicWithIntPositionals_InProgress = + { + Bar = None + Baz = None + Foo = None + Rest = ResizeArray () + } + /// A partially-parsed LoadsOfTypes. - type private LoadsOfTypes_InProgress = + type internal LoadsOfTypes_InProgress = { mutable AnotherOptionalThing : int option mutable Bar : string option @@ -284,8 +308,23 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : LoadsOfTypes_InProgress = + { + AnotherOptionalThing = None + Bar = None + Baz = None + Foo = None + OptionalThing = None + OptionalThingWithNoDefault = None + Positionals = ResizeArray () + SomeDirectory = None + SomeFile = None + SomeList = ResizeArray () + YetAnotherOptionalThing = None + } + /// A partially-parsed LoadsOfTypesNoPositionals. - type private LoadsOfTypesNoPositionals_InProgress = + type internal LoadsOfTypesNoPositionals_InProgress = { mutable AnotherOptionalThing : int option mutable Bar : string option @@ -376,8 +415,22 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : LoadsOfTypesNoPositionals_InProgress = + { + AnotherOptionalThing = None + Bar = None + Baz = None + Foo = None + OptionalThing = None + OptionalThingWithNoDefault = None + SomeDirectory = None + SomeFile = None + SomeList = ResizeArray () + YetAnotherOptionalThing = None + } + /// A partially-parsed DatesAndTimes. - type private DatesAndTimes_InProgress = + type internal DatesAndTimes_InProgress = { mutable Exact : TimeSpan option mutable Invariant : TimeSpan option @@ -431,8 +484,16 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : DatesAndTimes_InProgress = + { + Exact = None + Invariant = None + InvariantExact = None + Plain = None + } + /// A partially-parsed ChildRecord. - type private ChildRecord_InProgress = + type internal ChildRecord_InProgress = { mutable Thing1 : int option mutable Thing2 : string option @@ -468,8 +529,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ChildRecord_InProgress = + { + Thing1 = None + Thing2 = None + } + /// A partially-parsed ParentRecord. - type private ParentRecord_InProgress = + type internal ParentRecord_InProgress = { mutable AndAnother : bool option mutable Child : ChildRecord_InProgress @@ -505,8 +572,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ParentRecord_InProgress = + { + AndAnother = None + Child = ChildRecord_InProgress._Empty () + } + /// A partially-parsed ChildRecordWithPositional. - type private ChildRecordWithPositional_InProgress = + type internal ChildRecordWithPositional_InProgress = { mutable Thing1 : int option mutable Thing2 : ResizeArray @@ -544,8 +617,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ChildRecordWithPositional_InProgress = + { + Thing1 = None + Thing2 = ResizeArray () + } + /// A partially-parsed ParentRecordChildPos. - type private ParentRecordChildPos_InProgress = + type internal ParentRecordChildPos_InProgress = { mutable AndAnother : bool option mutable Child : ChildRecordWithPositional_InProgress @@ -581,8 +660,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ParentRecordChildPos_InProgress = + { + AndAnother = None + Child = ChildRecordWithPositional_InProgress._Empty () + } + /// A partially-parsed ParentRecordSelfPos. - type private ParentRecordSelfPos_InProgress = + type internal ParentRecordSelfPos_InProgress = { mutable AndAnother : ResizeArray mutable Child : ChildRecord_InProgress @@ -620,8 +705,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ParentRecordSelfPos_InProgress = + { + AndAnother = ResizeArray () + Child = ChildRecord_InProgress._Empty () + } + /// A partially-parsed ChoicePositionals. - type private ChoicePositionals_InProgress = + type internal ChoicePositionals_InProgress = { mutable Args : ResizeArray } @@ -649,8 +740,13 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ChoicePositionals_InProgress = + { + Args = ResizeArray () + } + /// A partially-parsed ContainsBoolEnvVar. - type private ContainsBoolEnvVar_InProgress = + type internal ContainsBoolEnvVar_InProgress = { mutable BoolVar : bool option } @@ -680,8 +776,13 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ContainsBoolEnvVar_InProgress = + { + BoolVar = None + } + /// A partially-parsed WithFlagDu. - type private WithFlagDu_InProgress = + type internal WithFlagDu_InProgress = { mutable DryRun : DryRunMode option } @@ -708,8 +809,13 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : WithFlagDu_InProgress = + { + DryRun = None + } + /// A partially-parsed ContainsFlagEnvVar. - type private ContainsFlagEnvVar_InProgress = + type internal ContainsFlagEnvVar_InProgress = { mutable DryRun : DryRunMode option } @@ -744,8 +850,13 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ContainsFlagEnvVar_InProgress = + { + DryRun = None + } + /// A partially-parsed ContainsFlagDefaultValue. - type private ContainsFlagDefaultValue_InProgress = + type internal ContainsFlagDefaultValue_InProgress = { mutable DryRun : DryRunMode option } @@ -770,8 +881,13 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ContainsFlagDefaultValue_InProgress = + { + DryRun = None + } + /// A partially-parsed ManyLongForms. - type private ManyLongForms_InProgress = + type internal ManyLongForms_InProgress = { mutable DoTheThing : string option mutable SomeFlag : bool option @@ -807,8 +923,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : ManyLongForms_InProgress = + { + DoTheThing = None + SomeFlag = None + } + /// A partially-parsed FlagsIntoPositionalArgs. - type private FlagsIntoPositionalArgs_InProgress = + type internal FlagsIntoPositionalArgs_InProgress = { mutable A : string option mutable GrabEverything : ResizeArray @@ -846,8 +968,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : FlagsIntoPositionalArgs_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + /// A partially-parsed FlagsIntoPositionalArgsChoice. - type private FlagsIntoPositionalArgsChoice_InProgress = + type internal FlagsIntoPositionalArgsChoice_InProgress = { mutable A : string option mutable GrabEverything : ResizeArray @@ -884,8 +1012,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : FlagsIntoPositionalArgsChoice_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + /// A partially-parsed FlagsIntoPositionalArgsInt. - type private FlagsIntoPositionalArgsInt_InProgress = + type internal FlagsIntoPositionalArgsInt_InProgress = { mutable A : string option mutable GrabEverything : ResizeArray @@ -923,8 +1057,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : FlagsIntoPositionalArgsInt_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. - type private FlagsIntoPositionalArgsIntChoice_InProgress = + type internal FlagsIntoPositionalArgsIntChoice_InProgress = { mutable A : string option mutable GrabEverything : ResizeArray @@ -961,8 +1101,14 @@ module private ArgParseHelpers_ConsumePlugin = else errors |> Seq.toList |> Error + static member _Empty () : FlagsIntoPositionalArgsIntChoice_InProgress = + { + A = None + GrabEverything = ResizeArray () + } + /// A partially-parsed FlagsIntoPositionalArgs'. - type private FlagsIntoPositionalArgs'_InProgress = + type internal FlagsIntoPositionalArgs'_InProgress = { mutable A : string option mutable DontGrabEverything : ResizeArray @@ -999,8 +1145,15 @@ module private ArgParseHelpers_ConsumePlugin = } else errors |> Seq.toList |> Error + + static member _Empty () : FlagsIntoPositionalArgs'_InProgress = + { + A = None + DontGrabEverything = ResizeArray () + } namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1008,7 +1161,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgs' [] module FlagsIntoPositionalArgs'ArgParse = - type private ParseState_FlagsIntoPositionalArgs' = + type internal ParseState_FlagsIntoPositionalArgs' = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1022,12 +1175,16 @@ module FlagsIntoPositionalArgs'ArgParse = (args : string list) : FlagsIntoPositionalArgs' = + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs'_InProgress._Empty () + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgs' = FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1035,7 +1192,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsIntChoice [] module FlagsIntoPositionalArgsIntChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsIntChoice = + type internal ParseState_FlagsIntoPositionalArgsIntChoice = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1049,12 +1206,16 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = (args : string list) : FlagsIntoPositionalArgsIntChoice = + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsIntChoice_InProgress._Empty () + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1062,7 +1223,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsInt [] module FlagsIntoPositionalArgsIntArgParse = - type private ParseState_FlagsIntoPositionalArgsInt = + type internal ParseState_FlagsIntoPositionalArgsInt = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1076,12 +1237,16 @@ module FlagsIntoPositionalArgsIntArgParse = (args : string list) : FlagsIntoPositionalArgsInt = + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsInt_InProgress._Empty () + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgsInt = FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1089,7 +1254,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgsChoice [] module FlagsIntoPositionalArgsChoiceArgParse = - type private ParseState_FlagsIntoPositionalArgsChoice = + type internal ParseState_FlagsIntoPositionalArgsChoice = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1103,12 +1268,16 @@ module FlagsIntoPositionalArgsChoiceArgParse = (args : string list) : FlagsIntoPositionalArgsChoice = + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsChoice_InProgress._Empty () + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgsChoice = FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1116,7 +1285,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type FlagsIntoPositionalArgs [] module FlagsIntoPositionalArgsArgParse = - type private ParseState_FlagsIntoPositionalArgs = + type internal ParseState_FlagsIntoPositionalArgs = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1130,12 +1299,16 @@ module FlagsIntoPositionalArgsArgParse = (args : string list) : FlagsIntoPositionalArgs = + let inProgress = + ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs_InProgress._Empty () + failwith "todo" static member parse (args : string list) : FlagsIntoPositionalArgs = FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1143,7 +1316,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ManyLongForms [] module ManyLongFormsArgParse = - type private ParseState_ManyLongForms = + type internal ParseState_ManyLongForms = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1153,12 +1326,14 @@ module ManyLongFormsArgParse = type ManyLongForms with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = + let inProgress = ArgParseHelpers_ConsumePlugin.ManyLongForms_InProgress._Empty () failwith "todo" static member parse (args : string list) : ManyLongForms = ManyLongForms.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1166,7 +1341,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsFlagDefaultValue [] module ContainsFlagDefaultValueArgParse = - type private ParseState_ContainsFlagDefaultValue = + type internal ParseState_ContainsFlagDefaultValue = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1180,12 +1355,16 @@ module ContainsFlagDefaultValueArgParse = (args : string list) : ContainsFlagDefaultValue = + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsFlagDefaultValue_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ContainsFlagDefaultValue = ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1193,7 +1372,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsFlagEnvVar [] module ContainsFlagEnvVarArgParse = - type private ParseState_ContainsFlagEnvVar = + type internal ParseState_ContainsFlagEnvVar = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1203,12 +1382,16 @@ module ContainsFlagEnvVarArgParse = type ContainsFlagEnvVar with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsFlagEnvVar = + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsFlagEnvVar_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ContainsFlagEnvVar = ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1216,7 +1399,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type WithFlagDu [] module WithFlagDuArgParse = - type private ParseState_WithFlagDu = + type internal ParseState_WithFlagDu = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1226,12 +1409,14 @@ module WithFlagDuArgParse = type WithFlagDu with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = + let inProgress = ArgParseHelpers_ConsumePlugin.WithFlagDu_InProgress._Empty () failwith "todo" static member parse (args : string list) : WithFlagDu = WithFlagDu.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1239,7 +1424,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ContainsBoolEnvVar [] module ContainsBoolEnvVarArgParse = - type private ParseState_ContainsBoolEnvVar = + type internal ParseState_ContainsBoolEnvVar = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1249,12 +1434,16 @@ module ContainsBoolEnvVarArgParse = type ContainsBoolEnvVar with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsBoolEnvVar = + let inProgress = + ArgParseHelpers_ConsumePlugin.ContainsBoolEnvVar_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ContainsBoolEnvVar = ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1262,7 +1451,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ChoicePositionals [] module ChoicePositionalsArgParse = - type private ParseState_ChoicePositionals = + type internal ParseState_ChoicePositionals = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1272,12 +1461,16 @@ module ChoicePositionalsArgParse = type ChoicePositionals with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ChoicePositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.ChoicePositionals_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ChoicePositionals = ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1285,7 +1478,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecordSelfPos [] module ParentRecordSelfPosArgParse = - type private ParseState_ParentRecordSelfPos = + type internal ParseState_ParentRecordSelfPos = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1295,12 +1488,16 @@ module ParentRecordSelfPosArgParse = type ParentRecordSelfPos with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordSelfPos = + let inProgress = + ArgParseHelpers_ConsumePlugin.ParentRecordSelfPos_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ParentRecordSelfPos = ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1308,7 +1505,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecordChildPos [] module ParentRecordChildPosArgParse = - type private ParseState_ParentRecordChildPos = + type internal ParseState_ParentRecordChildPos = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1318,12 +1515,16 @@ module ParentRecordChildPosArgParse = type ParentRecordChildPos with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecordChildPos = + let inProgress = + ArgParseHelpers_ConsumePlugin.ParentRecordChildPos_InProgress._Empty () + failwith "todo" static member parse (args : string list) : ParentRecordChildPos = ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1331,7 +1532,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type ParentRecord [] module ParentRecordArgParse = - type private ParseState_ParentRecord = + type internal ParseState_ParentRecord = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1341,12 +1542,14 @@ module ParentRecordArgParse = type ParentRecord with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = + let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecord_InProgress._Empty () failwith "todo" static member parse (args : string list) : ParentRecord = ParentRecord.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1354,7 +1557,7 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type DatesAndTimes [] module DatesAndTimesArgParse = - type private ParseState_DatesAndTimes = + type internal ParseState_DatesAndTimes = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed @@ -1364,12 +1567,14 @@ module DatesAndTimesArgParse = type DatesAndTimes with static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = + let inProgress = ArgParseHelpers_ConsumePlugin.DatesAndTimes_InProgress._Empty () failwith "todo" static member parse (args : string list) : DatesAndTimes = DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1377,19 +1582,23 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type LoadsOfTypesNoPositionals [] module LoadsOfTypesNoPositionals = - type private ParseState_LoadsOfTypesNoPositionals = + type internal ParseState_LoadsOfTypesNoPositionals = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypesNoPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.LoadsOfTypesNoPositionals_InProgress._Empty () + failwith "todo" let parse (args : string list) : LoadsOfTypesNoPositionals = parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1397,18 +1606,21 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type LoadsOfTypes [] module LoadsOfTypes = - type private ParseState_LoadsOfTypes = + type internal ParseState_LoadsOfTypes = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string - let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = failwith "todo" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = + let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypes_InProgress._Empty () + failwith "todo" let parse (args : string list) : LoadsOfTypes = parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1416,19 +1628,23 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type BasicWithIntPositionals [] module BasicWithIntPositionals = - type private ParseState_BasicWithIntPositionals = + type internal ParseState_BasicWithIntPositionals = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicWithIntPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.BasicWithIntPositionals_InProgress._Empty () + failwith "todo" let parse (args : string list) : BasicWithIntPositionals = parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1436,18 +1652,21 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type Basic [] module Basic = - type private ParseState_Basic = + type internal ParseState_Basic = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string - let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = failwith "todo" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = + let inProgress = ArgParseHelpers_ConsumePlugin.Basic_InProgress._Empty () + failwith "todo" let parse (args : string list) : Basic = parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin +open ArgParserHelpers open System open System.IO open WoofWare.Myriad.Plugins @@ -1455,13 +1674,17 @@ open WoofWare.Myriad.Plugins /// Methods to parse arguments for the type BasicNoPositionals [] module BasicNoPositionals = - type private ParseState_BasicNoPositionals = + type internal ParseState_BasicNoPositionals = /// Ready to consume a key or positional arg | AwaitingKey /// Waiting to receive a value for the key we've already consumed | AwaitingValue of key : string - let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicNoPositionals = failwith "todo" + let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicNoPositionals = + let inProgress = + ArgParseHelpers_ConsumePlugin.BasicNoPositionals_InProgress._Empty () + + failwith "todo" let parse (args : string list) : BasicNoPositionals = parse' System.Environment.GetEnvironmentVariable args diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index df4d5c6f..c31866bf 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -468,6 +468,7 @@ module internal ShibaGenerator = type internal ParsedRecordStructure<'choice> = { + NameOfInProgressType : Ident Original : RecordType /// Map of field name to parser for that field LeafNodes : Map> @@ -487,22 +488,22 @@ module internal ShibaGenerator = record.LeafNodes |> Map.toSeq |> Seq.map (fun (ident, data) -> - match data.Acc with - | Accumulation.Choice choice -> SynType.option data.TypeAfterParse - | Accumulation.ChoicePositional choice -> failwith "TODO" - | Accumulation.List acc -> - SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ] - | Accumulation.Optional -> SynType.option data.TypeAfterParse - | Accumulation.Required -> SynType.option data.TypeAfterParse - - |> fun ty -> - { - Attrs = [] - Type = ty - Ident = Some (Ident.create ident) - } + let ty, mutability = + match data.Acc with + | Accumulation.Choice _ -> SynType.option data.TypeAfterParse, true + | Accumulation.ChoicePositional _ -> failwith "TODO" + | Accumulation.List acc -> + SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ], false + | Accumulation.Optional -> SynType.option data.TypeAfterParse, true + | Accumulation.Required -> SynType.option data.TypeAfterParse, true + + { + Attrs = [] + Type = ty + Ident = Some (Ident.create ident) + } |> SynField.make - |> SynField.withMutability true + |> SynField.withMutability mutability ) |> Seq.toList @@ -519,7 +520,7 @@ module internal ShibaGenerator = { Attrs = [] Ident = Ident.create ident |> Some - Type = SynType.createLongIdent [ Ident.create $"%s{data.Original.Name.idText}_InProgress" ] + Type = SynType.createLongIdent [ data.NameOfInProgressType ] } |> SynField.make ) @@ -539,7 +540,7 @@ module internal ShibaGenerator = else l |> List.map (SynField.withMutability true) - let members = + let assembleMethod = // for each field `FieldName` in order, we've made a variable `arg%i` // which has done the optionality check let instantiation = @@ -783,18 +784,44 @@ module internal ShibaGenerator = SynType.list SynType.string ] ) + |> SynMemberDefn.memberImplementation + + let emptyConstructor = + [ + for KeyValue (nodeName, leaf) in record.LeafNodes do + let rhs = + match leaf.Acc with + | Accumulation.Required + | Accumulation.Optional + | Accumulation.Choice _ -> SynExpr.createIdent "None" + | Accumulation.ChoicePositional _ -> failwith "todo" + | Accumulation.List acc -> + SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ()) + + yield SynLongIdent.create [ Ident.create nodeName ], rhs + for KeyValue (nodeName, subRecord) in record.Records do + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subRecord.NameOfInProgressType) + for KeyValue (nodeName, subUnion) in record.Unions do + yield SynLongIdent.create [ Ident.create nodeName ], failwith "TODO" + ] + |> SynExpr.createRecord None + |> SynBinding.basic [ Ident.create "_Empty" ] [ SynPat.unit ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.NameOfInProgressType ]) + |> SynMemberDefn.staticMember { - Name = record.Original.Name.idText + "_InProgress" |> Ident.create + Name = record.NameOfInProgressType Fields = fields - Members = members |> SynMemberDefn.memberImplementation |> List.singleton |> Some + Members = [ assembleMethod ; emptyConstructor ] |> Some XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some Generics = match record.Original.Generics with | None -> None | Some _ -> failwith $"Record type %s{record.Original.Name.idText} had generics, which we don't support." - TypeAccessibility = Some (SynAccess.Private range0) + TypeAccessibility = Some (SynAccess.Internal range0) ImplAccessibility = None Attributes = [] } @@ -867,6 +894,7 @@ module internal ShibaGenerator = | None -> None | Some (leaf, records, unions) -> { + NameOfInProgressType = rt.Name.idText + "_InProgress" |> Ident.create Original = rt LeafNodes = leaf |> Map.ofList Records = records |> Map.ofList @@ -1034,14 +1062,16 @@ module internal ShibaGenerator = DatalessUnions = Map.ofList datalessUnions } + let helperModuleName (namespaceName : LongIdent) : Ident = + let ns = namespaceName |> List.map _.idText |> String.concat "_" + Ident.create $"ArgParseHelpers_%s{ns}" + let createHelpersModule (opens : SynOpenDeclTarget list) (ns : LongIdent) (info : AllInfo) : SynModuleDecl = - let modName = - let ns = ns |> List.map _.idText |> String.concat "_" - Ident.create $"ArgParseHelpers_%s{ns}" + let modName = helperModuleName ns let modInfo = SynComponentInfo.create modName - |> SynComponentInfo.withAccessibility (SynAccess.Private range0) + |> SynComponentInfo.withAccessibility (SynAccess.Internal range0) |> SynComponentInfo.withDocString (PreXmlDoc.create $"Helper types for arg parsing") let flagDuNames = info.FlagDus.Keys @@ -1073,8 +1103,8 @@ module internal ShibaGenerator = (opens : SynOpenDeclTarget list) (ns : LongIdent) ((taggedType : SynTypeDefn, spec : ArgParserOutputSpec)) - (allUnionTypes : UnionType list) - (allRecordTypes : RecordType list) + (helperModName : LongIdent) + (structures : AllInfo) : SynModuleOrNamespace = let taggedType = @@ -1087,6 +1117,8 @@ module internal ShibaGenerator = _) -> RecordType.OfRecord sci smd access fields | _ -> failwith "[] currently only supports being placed on records." + let taggedTypeInfo = structures.RecordParsers.[taggedType.Name.idText] + let modAttrs, modName = if spec.ExtensionMethods then [ SynAttribute.autoOpen ], Ident.create (taggedType.Name.idText + "ArgParse") @@ -1131,7 +1163,7 @@ module internal ShibaGenerator = |> SynTypeDefnRepr.union |> SynTypeDefn.create ( SynComponentInfo.create parseStateIdent - |> SynComponentInfo.setAccessibility (Some (SynAccess.Private range0)) + |> SynComponentInfo.setAccessibility (Some (SynAccess.Internal range0)) ) |> List.singleton |> SynModuleDecl.createTypes @@ -1144,6 +1176,17 @@ module internal ShibaGenerator = let parsePrime = SynExpr.CreateConst "todo" |> SynExpr.applyFunction (SynExpr.createIdent "failwith") + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "inProgress" ] + [] + (SynExpr.applyFunction + (SynExpr.createLongIdent' ( + helperModName @ [ taggedTypeInfo.NameOfInProgressType ; Ident.create "_Empty" ] + )) + (SynExpr.CreateConst ())) + ] |> SynBinding.basic [ Ident.create "parse'" ] [ @@ -1290,6 +1333,8 @@ type ShibaGenerator () = unionsAndRecordsByNs |> Map.map (fun _ (us, rs) -> ShibaGenerator.parseStructureWithinNs us rs) + let helperModNamespaceName = Ident.create "ArgParserHelpers" + let helpersMod = structuresWithinNs |> Map.toSeq @@ -1298,12 +1343,21 @@ type ShibaGenerator () = ) |> Seq.toList |> fun l -> [ yield! l ] - |> SynModuleOrNamespace.createNamespace [ Ident.create "ArgParserHelpers" ] + |> SynModuleOrNamespace.createNamespace [ helperModNamespaceName ] let modules = namespaceAndTypes - |> List.map (fun (ns, taggedType, unions, records) -> - ShibaGenerator.createModule opens ns taggedType unions records + |> List.map (fun (ns, taggedType, _, _) -> + let opens = + SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create [ helperModNamespaceName ], range0) + :: opens + + ShibaGenerator.createModule + opens + ns + taggedType + [ ShibaGenerator.helperModuleName ns ] + structuresWithinNs.[ns |> List.map _.idText |> String.concat "."] ) Output.Ast (helpersMod :: modules) From f8a1505b99213e58fb5b36800821e483df27fa09 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Mon, 14 Apr 2025 23:08:40 +0100 Subject: [PATCH 08/26] Undo build-offline mode --- Directory.Build.props | 1 - 1 file changed, 1 deletion(-) diff --git a/Directory.Build.props b/Directory.Build.props index 506a07b1..f0daa0b1 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -8,7 +8,6 @@ true embedded FS3388,FS3559 - $(NoWarn),NU1900 From fccc9810456cf692070fa6adeea1d19a201e11ad Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Tue, 15 Apr 2025 09:23:24 +0100 Subject: [PATCH 09/26] WIP --- ConsumePlugin/GeneratedArgs.fs | 140 ++++++++++++++++++---- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 32 ++++- 2 files changed, 149 insertions(+), 23 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 3f2563d5..d778a6bf 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -1178,7 +1178,12 @@ module FlagsIntoPositionalArgs'ArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs'_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs' = FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args @@ -1209,7 +1214,12 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsIntChoice_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args @@ -1240,7 +1250,12 @@ module FlagsIntoPositionalArgsIntArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsInt_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsInt = FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args @@ -1271,7 +1286,12 @@ module FlagsIntoPositionalArgsChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsChoice_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsChoice = FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args @@ -1302,7 +1322,12 @@ module FlagsIntoPositionalArgsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs = FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args @@ -1327,7 +1352,12 @@ module ManyLongFormsArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = let inProgress = ArgParseHelpers_ConsumePlugin.ManyLongForms_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ManyLongForms = ManyLongForms.parse' System.Environment.GetEnvironmentVariable args @@ -1358,7 +1388,12 @@ module ContainsFlagDefaultValueArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagDefaultValue_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ContainsFlagDefaultValue = ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args @@ -1385,7 +1420,12 @@ module ContainsFlagEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagEnvVar_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ContainsFlagEnvVar = ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args @@ -1410,7 +1450,12 @@ module WithFlagDuArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = let inProgress = ArgParseHelpers_ConsumePlugin.WithFlagDu_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : WithFlagDu = WithFlagDu.parse' System.Environment.GetEnvironmentVariable args @@ -1437,7 +1482,12 @@ module ContainsBoolEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsBoolEnvVar_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ContainsBoolEnvVar = ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args @@ -1464,7 +1514,12 @@ module ChoicePositionalsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ChoicePositionals_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ChoicePositionals = ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args @@ -1491,7 +1546,12 @@ module ParentRecordSelfPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordSelfPos_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ParentRecordSelfPos = ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args @@ -1518,7 +1578,12 @@ module ParentRecordChildPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordChildPos_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ParentRecordChildPos = ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args @@ -1543,7 +1608,12 @@ module ParentRecordArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecord_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : ParentRecord = ParentRecord.parse' System.Environment.GetEnvironmentVariable args @@ -1568,7 +1638,12 @@ module DatesAndTimesArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = let inProgress = ArgParseHelpers_ConsumePlugin.DatesAndTimes_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith static member parse (args : string list) : DatesAndTimes = DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args @@ -1592,7 +1667,12 @@ module LoadsOfTypesNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypesNoPositionals_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith let parse (args : string list) : LoadsOfTypesNoPositionals = parse' System.Environment.GetEnvironmentVariable args @@ -1614,7 +1694,12 @@ module LoadsOfTypes = let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypes_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith let parse (args : string list) : LoadsOfTypes = parse' System.Environment.GetEnvironmentVariable args @@ -1638,7 +1723,12 @@ module BasicWithIntPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicWithIntPositionals_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith let parse (args : string list) : BasicWithIntPositionals = parse' System.Environment.GetEnvironmentVariable args @@ -1660,7 +1750,12 @@ module Basic = let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = let inProgress = ArgParseHelpers_ConsumePlugin.Basic_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith let parse (args : string list) : Basic = parse' System.Environment.GetEnvironmentVariable args @@ -1684,7 +1779,12 @@ module BasicNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicNoPositionals_InProgress._Empty () - failwith "todo" + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith let parse (args : string list) : BasicNoPositionals = parse' System.Environment.GetEnvironmentVariable args diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index c31866bf..a8b332ba 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -5,7 +5,6 @@ open System.Collections.Generic open System.Text open Fantomas.FCS.Syntax open Fantomas.FCS.Text.Range -open TypeEquality open WoofWare.Myriad.Plugins open WoofWare.Whippet.Fantomas @@ -1173,9 +1172,30 @@ module internal ShibaGenerator = SynPat.named "args" |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) + let raiseErrors = + SynExpr.createIdent "e" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "String" ; "concat" ]) + (SynExpr.createLongIdent [ "System" ; "Environment" ; "NewLine" ]) + ) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") + let parsePrime = - SynExpr.CreateConst "todo" - |> SynExpr.applyFunction (SynExpr.createIdent "failwith") + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.named "result" ]) + (SynExpr.createIdent "result") + SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) raiseErrors + ] + |> SynExpr.createMatch (SynExpr.createIdent "parseAttempt") + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "parseAttempt" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO")) + ] |> SynExpr.createLet [ SynBinding.basic @@ -1186,6 +1206,12 @@ module internal ShibaGenerator = helperModName @ [ taggedTypeInfo.NameOfInProgressType ; Ident.create "_Empty" ] )) (SynExpr.CreateConst ())) + + SynBinding.basic + [ Ident.create "positionals" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) ] |> SynBinding.basic [ Ident.create "parse'" ] From 751e43eec4cd6070feeb5255a86928fac267e6e7 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Tue, 15 Apr 2025 22:50:14 +0100 Subject: [PATCH 10/26] More --- ConsumePlugin/GeneratedArgs.fs | 1819 +++++++++++++++++++-- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 246 ++- 2 files changed, 1904 insertions(+), 161 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index d778a6bf..cb7d60c4 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -26,12 +26,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Rest : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Foo with @@ -57,13 +59,21 @@ module internal ArgParseHelpers_ConsumePlugin = let arg3 : int list = this.Rest |> Seq.toList if errors.Count = 0 then - Ok - { - Foo = arg0 - Bar = arg1 - Baz = arg2 - Rest = arg3 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -75,6 +85,72 @@ module internal ArgParseHelpers_ConsumePlugin = Rest = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Int32.Parse x) |> this.Rest.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed Basic. type internal Basic_InProgress = { @@ -84,12 +160,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Rest : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Foo with @@ -122,13 +200,21 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> x) if errors.Count = 0 then - Ok - { - Foo = arg0 - Bar = arg1 - Baz = arg2 - Rest = arg3 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -140,6 +226,72 @@ module internal ArgParseHelpers_ConsumePlugin = Rest = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> x) |> this.Rest.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed BasicWithIntPositionals. type internal BasicWithIntPositionals_InProgress = { @@ -149,12 +301,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Rest : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Foo with @@ -187,13 +341,21 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> System.Int32.Parse x) if errors.Count = 0 then - Ok - { - Foo = arg0 - Bar = arg1 - Baz = arg2 - Rest = arg3 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + Rest = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -205,6 +367,72 @@ module internal ArgParseHelpers_ConsumePlugin = Rest = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Int32.Parse x) |> this.Rest.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed LoadsOfTypes. type internal LoadsOfTypes_InProgress = { @@ -221,12 +449,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable YetAnotherOptionalThing : string option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Foo with @@ -291,20 +521,28 @@ module internal ArgParseHelpers_ConsumePlugin = | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) if errors.Count = 0 then - Ok - { - Foo = arg0 - Bar = arg1 - Baz = arg2 - SomeFile = arg3 - SomeDirectory = arg4 - SomeList = arg5 - OptionalThingWithNoDefault = arg6 - Positionals = arg7 - OptionalThing = arg8 - AnotherOptionalThing = arg9 - YetAnotherOptionalThing = arg10 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + Positionals = arg7 + OptionalThing = arg8 + AnotherOptionalThing = arg9 + YetAnotherOptionalThing = arg10 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -323,6 +561,205 @@ module internal ArgParseHelpers_ConsumePlugin = YetAnotherOptionalThing = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals ( + key, + sprintf "--%s" "yet-another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.YetAnotherOptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "yet-another-optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.YetAnotherOptionalThing <- value |> (fun x -> 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) |> this.SomeList.Add + () |> Ok + else if + System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFile with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "some-file") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFile <- value |> (fun x -> System.IO.FileInfo x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeDirectory with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "some-directory") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeDirectory <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "positionals", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> System.Int32.Parse x) |> this.Positionals.Add + () |> Ok + else if + System.String.Equals ( + key, + sprintf "--%s" "optional-thing-with-no-default", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.OptionalThingWithNoDefault with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "optional-thing-with-no-default") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.OptionalThingWithNoDefault <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + then + match this.OptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.OptionalThing <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.AnotherOptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "another-optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AnotherOptionalThing <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed LoadsOfTypesNoPositionals. type internal LoadsOfTypesNoPositionals_InProgress = { @@ -338,12 +775,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable YetAnotherOptionalThing : string option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Foo with @@ -399,19 +838,27 @@ module internal ArgParseHelpers_ConsumePlugin = | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) if errors.Count = 0 then - Ok - { - Foo = arg0 - Bar = arg1 - Baz = arg2 - SomeFile = arg3 - SomeDirectory = arg4 - SomeList = arg5 - OptionalThingWithNoDefault = arg6 - OptionalThing = arg7 - AnotherOptionalThing = arg8 - YetAnotherOptionalThing = arg9 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Foo = arg0 + Bar = arg1 + Baz = arg2 + SomeFile = arg3 + SomeDirectory = arg4 + SomeList = arg5 + OptionalThingWithNoDefault = arg6 + OptionalThing = arg7 + AnotherOptionalThing = arg8 + YetAnotherOptionalThing = arg9 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -429,6 +876,200 @@ module internal ArgParseHelpers_ConsumePlugin = YetAnotherOptionalThing = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals ( + key, + sprintf "--%s" "yet-another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.YetAnotherOptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "yet-another-optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.YetAnotherOptionalThing <- value |> (fun x -> 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) |> this.SomeList.Add + () |> Ok + else if + System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFile with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "some-file") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFile <- value |> (fun x -> System.IO.FileInfo x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "some-directory", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeDirectory with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "some-directory") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeDirectory <- value |> (fun x -> System.IO.DirectoryInfo x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "optional-thing-with-no-default", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.OptionalThingWithNoDefault with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "optional-thing-with-no-default") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.OptionalThingWithNoDefault <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + then + match this.OptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.OptionalThing <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then + match this.Foo with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "foo") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "baz") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then + match this.Bar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bar") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Bar <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "another-optional-thing", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.AnotherOptionalThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "another-optional-thing") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AnotherOptionalThing <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed DatesAndTimes. type internal DatesAndTimes_InProgress = { @@ -438,12 +1079,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Plain : TimeSpan option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : TimeSpan = match this.Plain with @@ -474,13 +1117,21 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - Plain = arg0 - Invariant = arg1 - Exact = arg2 - InvariantExact = arg3 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Plain = arg0 + Invariant = arg1 + Exact = arg2 + InvariantExact = arg3 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -492,6 +1143,114 @@ module internal ArgParseHelpers_ConsumePlugin = Plain = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "plain", System.StringComparison.OrdinalIgnoreCase) then + match this.Plain with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "plain") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Plain <- value |> (fun x -> System.TimeSpan.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "invariant-exact", System.StringComparison.OrdinalIgnoreCase) + then + match this.InvariantExact with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "invariant-exact") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.InvariantExact <- + value + |> (fun x -> + System.TimeSpan.ParseExact ( + x, + @"hh\:mm\:ss", + System.Globalization.CultureInfo.InvariantCulture + ) + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "invariant", System.StringComparison.OrdinalIgnoreCase) + then + match this.Invariant with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "invariant") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Invariant <- + value + |> (fun x -> System.TimeSpan.Parse (x, System.Globalization.CultureInfo.InvariantCulture)) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "exact", System.StringComparison.OrdinalIgnoreCase) then + match this.Exact with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "exact") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Exact <- + value + |> (fun x -> + System.TimeSpan.ParseExact ( + x, + @"hh\:mm\:ss", + System.Globalization.CultureInfo.CurrentCulture + ) + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ChildRecord. type internal ChildRecord_InProgress = { @@ -499,12 +1258,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Thing2 : string option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Thing1 with @@ -521,11 +1282,19 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - Thing1 = arg0 - Thing2 = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Thing1 = arg0 + Thing2 = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -535,6 +1304,52 @@ module internal ArgParseHelpers_ConsumePlugin = Thing2 = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "thing2", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing2 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing2") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing2 <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if System.String.Equals (key, sprintf "--%s" "thing1", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing1 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing1") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing1 <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ParentRecord. type internal ParentRecord_InProgress = { @@ -542,16 +1357,23 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Child : ChildRecord_InProgress } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : ChildRecord = match this.Child.Assemble getEnvironmentVariable positionals with - | Ok result -> result + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result | Error err -> errors.AddRange err Unchecked.defaultof<_> @@ -564,11 +1386,19 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - Child = arg0 - AndAnother = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -578,6 +1408,35 @@ module internal ArgParseHelpers_ConsumePlugin = Child = ChildRecord_InProgress._Empty () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "and-another") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AndAnother <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ChildRecordWithPositional. type internal ChildRecordWithPositional_InProgress = { @@ -585,12 +1444,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Thing2 : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : int = match this.Thing1 with @@ -609,11 +1470,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> System.Uri x) if errors.Count = 0 then - Ok - { - Thing1 = arg0 - Thing2 = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Thing1 = arg0 + Thing2 = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -623,6 +1492,38 @@ module internal ArgParseHelpers_ConsumePlugin = Thing2 = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "thing2", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Uri x) |> this.Thing2.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "thing1", System.StringComparison.OrdinalIgnoreCase) then + match this.Thing1 with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "thing1") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.Thing1 <- value |> (fun x -> System.Int32.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ParentRecordChildPos. type internal ParentRecordChildPos_InProgress = { @@ -630,16 +1531,23 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Child : ChildRecordWithPositional_InProgress } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : ChildRecordWithPositional = match this.Child.Assemble getEnvironmentVariable positionals with - | Ok result -> result + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result | Error err -> errors.AddRange err Unchecked.defaultof<_> @@ -652,11 +1560,19 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - Child = arg0 - AndAnother = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -666,6 +1582,35 @@ module internal ArgParseHelpers_ConsumePlugin = Child = ChildRecordWithPositional_InProgress._Empty () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "and-another") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.AndAnother <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ParentRecordSelfPos. type internal ParentRecordSelfPos_InProgress = { @@ -673,16 +1618,23 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Child : ChildRecord_InProgress } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : ChildRecord = match this.Child.Assemble getEnvironmentVariable positionals with - | Ok result -> result + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result | Error err -> errors.AddRange err Unchecked.defaultof<_> @@ -697,11 +1649,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> System.Boolean.Parse x) if errors.Count = 0 then - Ok - { - Child = arg0 - AndAnother = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Child = arg0 + AndAnother = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -711,18 +1671,35 @@ module internal ArgParseHelpers_ConsumePlugin = Child = ChildRecord_InProgress._Empty () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> System.Boolean.Parse x) |> this.AndAnother.Add + () |> Ok + else + Error None + /// A partially-parsed ChoicePositionals. type internal ChoicePositionals_InProgress = { mutable Args : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : Choice list = positionals @@ -733,10 +1710,18 @@ module internal ArgParseHelpers_ConsumePlugin = ) if errors.Count = 0 then - Ok - { - Args = arg0 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + Args = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -745,18 +1730,35 @@ module internal ArgParseHelpers_ConsumePlugin = Args = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "args", System.StringComparison.OrdinalIgnoreCase) then + value |> (fun x -> x) |> this.Args.Add + () |> Ok + else + Error None + /// A partially-parsed ContainsBoolEnvVar. type internal ContainsBoolEnvVar_InProgress = { mutable BoolVar : bool option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : Choice = match this.BoolVar with @@ -769,10 +1771,18 @@ module internal ArgParseHelpers_ConsumePlugin = ) if errors.Count = 0 then - Ok - { - BoolVar = arg0 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + BoolVar = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -781,18 +1791,49 @@ module internal ArgParseHelpers_ConsumePlugin = BoolVar = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then + match this.BoolVar with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "bool-var") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.BoolVar <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed WithFlagDu. type internal WithFlagDu_InProgress = { mutable DryRun : DryRunMode option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : DryRunMode = match this.DryRun with @@ -802,10 +1843,18 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - DryRun = arg0 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -814,18 +1863,58 @@ module internal ArgParseHelpers_ConsumePlugin = DryRun = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ContainsFlagEnvVar. type internal ContainsFlagEnvVar_InProgress = { mutable DryRun : DryRunMode option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : Choice = match this.DryRun with @@ -843,10 +1932,18 @@ module internal ArgParseHelpers_ConsumePlugin = ) if errors.Count = 0 then - Ok - { - DryRun = arg0 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -855,18 +1952,58 @@ module internal ArgParseHelpers_ConsumePlugin = DryRun = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ContainsFlagDefaultValue. type internal ContainsFlagDefaultValue_InProgress = { mutable DryRun : DryRunMode option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : Choice = match this.DryRun with @@ -874,10 +2011,18 @@ module internal ArgParseHelpers_ConsumePlugin = | None -> Choice2Of2 (ContainsFlagDefaultValue.DefaultDryRun ()) if errors.Count = 0 then - Ok - { - DryRun = arg0 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + DryRun = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -886,6 +2031,44 @@ module internal ArgParseHelpers_ConsumePlugin = DryRun = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "dry-run") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DryRun <- + value + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) + |> Some + + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed ManyLongForms. type internal ManyLongForms_InProgress = { @@ -893,12 +2076,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable SomeFlag : bool option } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.DoTheThing with @@ -915,11 +2100,19 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> if errors.Count = 0 then - Ok - { - DoTheThing = arg0 - SomeFlag = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + DoTheThing = arg0 + SomeFlag = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -929,6 +2122,98 @@ module internal ArgParseHelpers_ConsumePlugin = SomeFlag = None } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "dont-turn-it-off", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFlag <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.SomeFlag <- value |> (fun x -> System.Boolean.Parse x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals (key, sprintf "--%s" "anotherarg", System.StringComparison.OrdinalIgnoreCase) + then + match this.DoTheThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "do-something-else" "anotherarg") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DoTheThing <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else if + System.String.Equals ( + key, + sprintf "--%s" "do-something-else", + System.StringComparison.OrdinalIgnoreCase + ) + then + match this.DoTheThing with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s / --%s" "do-something-else" "anotherarg") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.DoTheThing <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed FlagsIntoPositionalArgs. type internal FlagsIntoPositionalArgs_InProgress = { @@ -936,12 +2221,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable GrabEverything : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.A with @@ -960,11 +2247,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> x) if errors.Count = 0 then - Ok - { - A = arg0 - GrabEverything = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -974,6 +2269,40 @@ module internal ArgParseHelpers_ConsumePlugin = GrabEverything = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> x) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed FlagsIntoPositionalArgsChoice. type internal FlagsIntoPositionalArgsChoice_InProgress = { @@ -981,12 +2310,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable GrabEverything : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.A with @@ -1004,11 +2335,19 @@ module internal ArgParseHelpers_ConsumePlugin = ) if errors.Count = 0 then - Ok - { - A = arg0 - GrabEverything = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -1018,6 +2357,40 @@ module internal ArgParseHelpers_ConsumePlugin = GrabEverything = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> x) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed FlagsIntoPositionalArgsInt. type internal FlagsIntoPositionalArgsInt_InProgress = { @@ -1025,12 +2398,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable GrabEverything : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.A with @@ -1049,11 +2424,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> System.Int32.Parse x) if errors.Count = 0 then - Ok - { - A = arg0 - GrabEverything = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -1063,6 +2446,40 @@ module internal ArgParseHelpers_ConsumePlugin = GrabEverything = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> System.Int32.Parse x) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type internal FlagsIntoPositionalArgsIntChoice_InProgress = { @@ -1070,12 +2487,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable GrabEverything : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.A with @@ -1093,11 +2512,19 @@ module internal ArgParseHelpers_ConsumePlugin = ) if errors.Count = 0 then - Ok - { - A = arg0 - GrabEverything = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + GrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -1107,6 +2534,40 @@ module internal ArgParseHelpers_ConsumePlugin = GrabEverything = ResizeArray () } + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) + then + value |> (fun x -> System.Int32.Parse x) |> this.GrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None + /// A partially-parsed FlagsIntoPositionalArgs'. type internal FlagsIntoPositionalArgs'_InProgress = { @@ -1114,12 +2575,14 @@ module internal ArgParseHelpers_ConsumePlugin = mutable DontGrabEverything : ResizeArray } + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble (getEnvironmentVariable : string -> string) (positionals : Choice list) - : Result + : Result = let errors = ResizeArray () + let positionalConsumers = ResizeArray () let arg0 : string = match this.A with @@ -1138,11 +2601,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> List.map (fun x -> x) if errors.Count = 0 then - Ok - { - A = arg0 - DontGrabEverything = arg1 - } + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + DontGrabEverything = arg1 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error else errors |> Seq.toList |> Error @@ -1151,6 +2622,44 @@ module internal ArgParseHelpers_ConsumePlugin = A = None DontGrabEverything = ResizeArray () } + + /// Processes the key-value pair, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + if + System.String.Equals ( + key, + sprintf "--%s" "dont-grab-everything", + System.StringComparison.OrdinalIgnoreCase + ) + then + value |> (fun x -> x) |> this.DontGrabEverything.Add + () |> Ok + else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then + match this.A with + | Some x -> + sprintf + "Argument '%s' was supplied multiple times: %s and %s" + (sprintf "--%s" "a") + (x.ToString ()) + (value.ToString ()) + |> errors_.Add + + Ok () + | None -> + try + this.A <- value |> (fun x -> x) |> Some + Ok () + with _ as exc -> + exc.Message |> Some |> Error + else + Error None namespace ConsumePlugin open ArgParserHelpers diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index a8b332ba..a2c5bcac 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -132,8 +132,24 @@ module internal ShibaGenerator = /// `None` if not positional. `Some None` if positional and the PositionalArgs attribute had no contents. /// `Some Some` if the PositionalArgs attribute had an argument. Positional : SynExpr option option + /// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might + /// get confused with positional args or something! I haven't thought that hard about this. + /// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have + /// omitted the initial `--` that will be required at runtime. + ArgForm : SynExpr list + /// Name of the field of the in-progress record storing this leaf. + TargetConstructionField : Ident } + /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all + /// the ways they can refer to this arg. + member arg.HumanReadableArgForm : SynExpr = + let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / " + + (SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm) + ||> List.fold SynExpr.applyFunction + |> SynExpr.paren + type private ParseFunctionSpec<'choice> = /// A leaf node, e.g. `--foo=3`. | Leaf of LeafData<'choice> @@ -172,6 +188,20 @@ module internal ShibaGenerator = | _ -> None ) + let longForms = + attrs + |> List.choose (fun attr -> + match attr.TypeName with + | SynLongIdent.SynLongIdent (ident, _, _) -> + match (List.last ident).idText with + | "ArgumentLongForm" + | "ArgumentLongFormAttribute" -> Some attr.ArgExpr + | _ -> None + ) + |> function + | [] -> List.singleton (SynExpr.CreateConst (argify fieldName)) + | l -> List.ofSeq l + match ty with | String -> { @@ -179,6 +209,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = SynType.string Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | PrimitiveType pt -> @@ -192,6 +224,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | Uri -> @@ -203,6 +237,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | TimeSpan -> @@ -263,6 +299,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | FileInfo -> @@ -276,6 +314,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | DirectoryInfo -> @@ -289,6 +329,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf | OptionType eltTy -> @@ -457,6 +499,8 @@ module internal ShibaGenerator = Acc = Accumulation.Required TypeAfterParse = ty Positional = positional + ArgForm = longForms + TargetConstructionField = fieldName } |> ParseFunctionSpec.Leaf @@ -481,6 +525,131 @@ module internal ShibaGenerator = Cases : Map> } + /// `member this.ProcessKeyValue (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// Returns a possible error. + /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do + /// the parse because in fact the key decided not to take this argument); in that case we return Error None. + let private processKeyValue<'choice> (args : LeafData<'choice> list) : SynBinding = + let args = + args + |> List.map (fun arg -> + match arg.Acc with + | Accumulation.Required + | Accumulation.Choice _ + | Accumulation.ChoicePositional _ + | Accumulation.Optional -> + let multipleErrorMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s") + |> SynExpr.applyTo arg.HumanReadableArgForm + |> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren) + |> SynExpr.applyTo ( + SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren + ) + + let performAssignment = + [ + SynExpr.createIdent "value" + |> SynExpr.pipeThroughFunction arg.ParseFn + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") + |> SynExpr.assign ( + SynLongIdent.create [ Ident.create "this" ; arg.TargetConstructionField ] + ) + + SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ()) + ] + |> SynExpr.sequential + + [ + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.named "x" ]) + (SynExpr.sequential + [ + multipleErrorMessage + |> SynExpr.pipeThroughFunction ( + SynExpr.dotGet "Add" (SynExpr.createIdent "errors_") + ) + SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ()) + ]) + SynMatchClause.create + (SynPat.named "None") + (SynExpr.pipeThroughTryWith + SynPat.anon + (SynExpr.createLongIdent [ "exc" ; "Message" ] + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + performAssignment) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent' [ Ident.create "this" ; arg.TargetConstructionField ] + ) + | Accumulation.List (Accumulation.List _) + | Accumulation.List Accumulation.Optional + | Accumulation.List (Accumulation.Choice _) -> + failwith + "WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists." + | Accumulation.List (Accumulation.ChoicePositional _) + // ChoicePositional gets aggregated just like any other arg into its containing list; + // it's only when freezing the in-progress structure that we annotate them with choice information. + | Accumulation.List Accumulation.Required -> + [ + SynExpr.createIdent "value" + |> SynExpr.pipeThroughFunction arg.ParseFn + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent' + [ Ident.create "this" ; arg.TargetConstructionField ; Ident.create "Add" ] + ) + SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok") + ] + |> SynExpr.sequential + |> fun expr -> arg.ArgForm, expr + ) + + // let posArg = + // SynExpr.createIdent "value" + // |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent ["positionals" ; "Add"]) + // |> List.singleton + + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), args) + ||> List.fold (fun finalBranch (argForm, arg) -> + (finalBranch, argForm) + ||> List.fold (fun finalBranch argForm -> + arg + |> SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "key" + SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "--%s")) + argForm + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + finalBranch + ) + ) + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValue" ] + [ + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.unit ; SynType.appPostfix "option" SynType.string ] + ) + |> SynBinding.withXmlDoc ( + [ + " Processes the key-value pair, returning Error if no key was matched." + " If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error()." + " This can nevertheless be a successful parse, e.g. when the key may have arity 0." + ] + |> PreXmlDoc.create' + ) + /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". let private inProgressRecordType (record : ParsedRecordStructure) : RecordType = let leafFields = @@ -552,6 +721,15 @@ module internal ShibaGenerator = | Some ident -> SynLongIdent.create [ ident ], SynExpr.createIdent $"arg%i{i}" ) |> SynExpr.createRecord None + |> fun record -> + SynExpr.tupleNoParen + [ + record + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "tryExactlyOne" ]) + (SynExpr.createIdent "positionalConsumers") + ] + |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createIdent "Ok") let defaultOf = @@ -581,8 +759,27 @@ module internal ShibaGenerator = SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Ok" ] - (SynArgPats.create [ SynPat.named "result" ])) - (SynExpr.createIdent "result") + (SynArgPats.create + [ SynPat.named "result" ; SynPat.named "consumedPositional" ])) + (SynExpr.sequential + [ + SynExpr.createMatch + (SynExpr.createIdent "consumedPositional") + [ + SynMatchClause.create + (SynPat.named "None") + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.nameWithArgs + "Some" + [ SynPat.named "positionalConsumer" ]) + (SynExpr.callMethodArg + "Add" + (SynExpr.createIdent "positionalConsumer") + (SynExpr.createIdent "positionalConsumers")) + ] + SynExpr.createIdent "result" + ]) SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Error" ] @@ -617,6 +814,8 @@ module internal ShibaGenerator = | Accumulation.List _ -> failwith "unexpected: positional args should not be a list of lists" | Accumulation.Required -> + // TODO: we need to preserve the ordering on these with respect to + // the explicitly passed `--foo=` positionals SynExpr.createIdent "positionals" |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction @@ -749,12 +948,24 @@ module internal ShibaGenerator = |> List.singleton ) - SynExpr.ifThenElse + instantiation + |> SynExpr.ifThenElse + (SynExpr.lessThanOrEqual + (SynExpr.CreateConst 1) + (SynExpr.dotGet "Count" (SynExpr.createIdent "positionalConsumers"))) + (SynExpr.createIdent "positionalConsumers" + |> SynExpr.applyFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst ", ") + ) + |> SynExpr.plus (SynExpr.CreateConst "Multiple parsers consumed positional args: ") + |> SynExpr.paren + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "List" ; "singleton" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + |> SynExpr.ifThenElse (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) (SynExpr.createIdent "errors" |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) - instantiation |> SynExpr.createLet assignVariables |> SynExpr.createLet [ @@ -764,6 +975,12 @@ module internal ShibaGenerator = (SynExpr.applyFunction (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) (SynExpr.CreateConst ())) + SynBinding.basic + [ Ident.create "positionalConsumers" ] + [] + (SynExpr.applyFunction + (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) + (SynExpr.CreateConst ())) ] |> SynBinding.basic [ Ident.create "this" ; Ident.create "Assemble" ] @@ -779,10 +996,19 @@ module internal ShibaGenerator = SynType.app "Result" [ - SynType.createLongIdent [ record.Original.Name ] + SynType.tupleNoParen + [ + SynType.createLongIdent [ record.Original.Name ] + SynType.option SynType.string + ] + |> Option.get SynType.list SynType.string ] ) + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args." + ) |> SynMemberDefn.memberImplementation let emptyConstructor = @@ -810,10 +1036,18 @@ module internal ShibaGenerator = |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.NameOfInProgressType ]) |> SynMemberDefn.staticMember + let processKeyValue = + record.LeafNodes + |> Map.toSeq + |> Seq.map snd + |> Seq.toList + |> processKeyValue + |> SynMemberDefn.memberImplementation + { Name = record.NameOfInProgressType Fields = fields - Members = [ assembleMethod ; emptyConstructor ] |> Some + Members = [ assembleMethod ; emptyConstructor ; processKeyValue ] |> Some XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some Generics = match record.Original.Generics with From 4e62a154c0cda4332090d2b0789d0bea843ff2b2 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Tue, 15 Apr 2025 22:51:43 +0100 Subject: [PATCH 11/26] Undo accidental revert --- .../WoofWare.Myriad.Plugins.Test.fsproj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index 639f8b59..c8f6a616 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -43,7 +43,7 @@ - + From aa2ef830c326f57af100d2ea4902cf3e23396da6 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Wed, 16 Apr 2025 21:26:30 +0100 Subject: [PATCH 12/26] Add flags --- ConsumePlugin/GeneratedArgs.fs | 364 +++++++++++++++++++--- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 108 ++++++- 2 files changed, 420 insertions(+), 52 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index cb7d60c4..24122bd8 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -27,7 +27,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -88,7 +88,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -151,6 +151,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + /// A partially-parsed Basic. type internal Basic_InProgress = { @@ -161,7 +176,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -229,7 +244,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -292,6 +307,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + /// A partially-parsed BasicWithIntPositionals. type internal BasicWithIntPositionals_InProgress = { @@ -302,7 +332,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -370,7 +400,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -433,6 +463,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + /// A partially-parsed LoadsOfTypes. type internal LoadsOfTypes_InProgress = { @@ -450,7 +495,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -564,7 +609,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -760,6 +805,33 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + then + match this.OptionalThing with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") + |> errors_.Add + + true + | None -> + this.OptionalThing <- true |> Some + true + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + /// A partially-parsed LoadsOfTypesNoPositionals. type internal LoadsOfTypesNoPositionals_InProgress = { @@ -776,7 +848,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -879,7 +951,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1070,6 +1142,33 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if + System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) + then + match this.OptionalThing with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") + |> errors_.Add + + true + | None -> + this.OptionalThing <- true |> Some + true + else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then + match this.Baz with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") + |> errors_.Add + + true + | None -> + this.Baz <- true |> Some + true + else + false + /// A partially-parsed DatesAndTimes. type internal DatesAndTimes_InProgress = { @@ -1080,7 +1179,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1146,7 +1245,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1251,6 +1350,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed ChildRecord. type internal ChildRecord_InProgress = { @@ -1259,7 +1361,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1307,7 +1409,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1350,6 +1452,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed ParentRecord. type internal ParentRecord_InProgress = { @@ -1358,7 +1463,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1367,7 +1472,7 @@ module internal ArgParseHelpers_ConsumePlugin = let positionalConsumers = ResizeArray () let arg0 : ChildRecord = - match this.Child.Assemble getEnvironmentVariable positionals with + match this.Child.Assemble_ getEnvironmentVariable positionals with | Ok (result, consumedPositional) -> match consumedPositional with | None -> () @@ -1411,7 +1516,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1437,6 +1542,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") + |> errors_.Add + + true + | None -> + this.AndAnother <- true |> Some + true + else + false + /// A partially-parsed ChildRecordWithPositional. type internal ChildRecordWithPositional_InProgress = { @@ -1445,7 +1565,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1495,7 +1615,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1524,6 +1644,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed ParentRecordChildPos. type internal ParentRecordChildPos_InProgress = { @@ -1532,7 +1655,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1541,7 +1664,7 @@ module internal ArgParseHelpers_ConsumePlugin = let positionalConsumers = ResizeArray () let arg0 : ChildRecordWithPositional = - match this.Child.Assemble getEnvironmentVariable positionals with + match this.Child.Assemble_ getEnvironmentVariable positionals with | Ok (result, consumedPositional) -> match consumedPositional with | None -> () @@ -1585,7 +1708,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1611,6 +1734,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then + match this.AndAnother with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") + |> errors_.Add + + true + | None -> + this.AndAnother <- true |> Some + true + else + false + /// A partially-parsed ParentRecordSelfPos. type internal ParentRecordSelfPos_InProgress = { @@ -1619,7 +1757,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1628,7 +1766,7 @@ module internal ArgParseHelpers_ConsumePlugin = let positionalConsumers = ResizeArray () let arg0 : ChildRecord = - match this.Child.Assemble getEnvironmentVariable positionals with + match this.Child.Assemble_ getEnvironmentVariable positionals with | Ok (result, consumedPositional) -> match consumedPositional with | None -> () @@ -1674,7 +1812,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1686,6 +1824,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed ChoicePositionals. type internal ChoicePositionals_InProgress = { @@ -1693,7 +1834,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1733,7 +1874,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1745,6 +1886,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed ContainsBoolEnvVar. type internal ContainsBoolEnvVar_InProgress = { @@ -1752,7 +1896,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1794,7 +1938,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1820,6 +1964,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then + match this.BoolVar with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "bool-var") + |> errors_.Add + + true + | None -> + this.BoolVar <- true |> Some + true + else + false + /// A partially-parsed WithFlagDu. type internal WithFlagDu_InProgress = { @@ -1827,7 +1986,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1866,7 +2025,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1901,6 +2060,27 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + /// A partially-parsed ContainsFlagEnvVar. type internal ContainsFlagEnvVar_InProgress = { @@ -1908,7 +2088,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -1955,7 +2135,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1990,6 +2170,27 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + /// A partially-parsed ContainsFlagDefaultValue. type internal ContainsFlagDefaultValue_InProgress = { @@ -1997,7 +2198,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2034,7 +2235,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2069,6 +2270,27 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then + match this.DryRun with + | Some x -> + sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") + |> errors_.Add + + true + | None -> + this.DryRun <- + if true = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + |> Some + + true + else + false + /// A partially-parsed ManyLongForms. type internal ManyLongForms_InProgress = { @@ -2077,7 +2299,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2125,7 +2347,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2214,6 +2436,39 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = + if + System.String.Equals (key, sprintf "--%s" "dont-turn-it-off", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Flag '%s' was supplied multiple times" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + |> errors_.Add + + true + | None -> + this.SomeFlag <- true |> Some + true + else if + System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) + then + match this.SomeFlag with + | Some x -> + sprintf + "Flag '%s' was supplied multiple times" + (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") + |> errors_.Add + + true + | None -> + this.SomeFlag <- true |> Some + true + else + false + /// A partially-parsed FlagsIntoPositionalArgs. type internal FlagsIntoPositionalArgs_InProgress = { @@ -2222,7 +2477,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2272,7 +2527,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2303,6 +2558,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed FlagsIntoPositionalArgsChoice. type internal FlagsIntoPositionalArgsChoice_InProgress = { @@ -2311,7 +2569,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2360,7 +2618,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2391,6 +2649,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed FlagsIntoPositionalArgsInt. type internal FlagsIntoPositionalArgsInt_InProgress = { @@ -2399,7 +2660,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2449,7 +2710,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2480,6 +2741,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type internal FlagsIntoPositionalArgsIntChoice_InProgress = { @@ -2488,7 +2752,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2537,7 +2801,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2568,6 +2832,9 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// A partially-parsed FlagsIntoPositionalArgs'. type internal FlagsIntoPositionalArgs'_InProgress = { @@ -2576,7 +2843,7 @@ module internal ArgParseHelpers_ConsumePlugin = } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. - member this.Assemble + member this.Assemble_ (getEnvironmentVariable : string -> string) (positionals : Choice list) : Result @@ -2626,7 +2893,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue + member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2660,6 +2927,9 @@ module internal ArgParseHelpers_ConsumePlugin = exc.Message |> Some |> Error else Error None + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false namespace ConsumePlugin open ArgParserHelpers diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index a2c5bcac..0c15a127 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -517,6 +517,7 @@ module internal ShibaGenerator = LeafNodes : Map> Records : Map> Unions : Map> + FlagDus : FlagDu list } and internal ParsedUnionStructure<'choice> = @@ -525,7 +526,74 @@ module internal ShibaGenerator = Cases : Map> } - /// `member this.ProcessKeyValue (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// `member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = ...` + /// The second member of the `flags` list tuple is the constant "true" with which we will interpret the + /// arity-0 `--foo`. So in the case of a boolean-typed field, this is `true`; in the case of a Flag-typed field, + /// this is `FlagType.WhicheverCaseHadTrue`. + let private setFlagValue (flags : (LeafData<'choice> * SynExpr) list) : SynBinding = + (SynExpr.CreateConst false, flags) + ||> List.fold (fun finalExpr (flag, trueCase) -> + let multipleErrorMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "Flag '%s' was supplied multiple times") + |> SynExpr.applyTo flag.HumanReadableArgForm + + let matchFlag = + [ + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.anon ]) + // This is an error, but it's one we can gracefully report at the end. + (SynExpr.sequential + [ + multipleErrorMessage + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent "errors_")) + SynExpr.CreateConst true + ]) + + SynMatchClause.create + (SynPat.named "None") + ([ + SynExpr.assign + (SynLongIdent.create [ Ident.create "this" ; flag.TargetConstructionField ]) + (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase) + SynExpr.CreateConst true + ] + |> SynExpr.sequential) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent' [ Ident.create "this" ; flag.TargetConstructionField ] + ) + + (finalExpr, flag.ArgForm) + ||> List.fold (fun finalExpr argForm -> + SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "key" + SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "--%s")) + argForm + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + finalExpr + matchFlag + ) + ) + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "SetFlagValue_" ] + [ + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + ] + |> SynBinding.withReturnAnnotation (SynType.named "bool") + |> SynBinding.withXmlDoc (PreXmlDoc.create "Returns false if we didn't set a value.") + |> SynBinding.makeInstanceMember + + /// `member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` /// Returns a possible error. /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do /// the parse because in fact the key decided not to take this argument); in that case we return Error None. @@ -632,7 +700,7 @@ module internal ShibaGenerator = ) ) |> SynBinding.basic - [ Ident.create "this" ; Ident.create "ProcessKeyValue" ] + [ Ident.create "this" ; Ident.create "ProcessKeyValue_" ] [ SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") SynPat.annotateType SynType.string (SynPat.named "key") @@ -649,6 +717,7 @@ module internal ShibaGenerator = ] |> PreXmlDoc.create' ) + |> SynBinding.makeInstanceMember /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". let private inProgressRecordType (record : ParsedRecordStructure) : RecordType = @@ -751,7 +820,7 @@ module internal ShibaGenerator = // This was a record; defer to its parser. let subAssembleCall = SynExpr.dotGet ident.idText (SynExpr.createIdent "this") - |> SynExpr.callMethodArg "Assemble" (SynExpr.createIdent "getEnvironmentVariable") + |> SynExpr.callMethodArg "Assemble_" (SynExpr.createIdent "getEnvironmentVariable") |> SynExpr.applyTo (SynExpr.createIdent "positionals") // TODO: need to know if it has positionals @@ -983,7 +1052,7 @@ module internal ShibaGenerator = (SynExpr.CreateConst ())) ] |> SynBinding.basic - [ Ident.create "this" ; Ident.create "Assemble" ] + [ Ident.create "this" ; Ident.create "Assemble_" ] [ SynPat.annotateType (SynType.funFromDomain SynType.string SynType.string) @@ -1044,10 +1113,38 @@ module internal ShibaGenerator = |> processKeyValue |> SynMemberDefn.memberImplementation + let flags = + record.LeafNodes + |> Map.toSeq + |> Seq.choose (fun (_, pf) -> + match pf.Acc with + | Required + | Optional + | Accumulation.Choice _ -> Some pf + // We don't allow flags to be passed multiple times and accumulated into a list. + | Accumulation.List _ + | Accumulation.ChoicePositional _ -> None + ) + |> Seq.choose (fun pf -> + match pf.TypeAfterParse with + | PrimitiveType pt -> + if (pt |> List.map _.idText) = [ "System" ; "Boolean" ] then + Some (pf, SynExpr.CreateConst true) + else + None + | ty -> + match identifyAsFlag record.FlagDus ty with + | Some flag -> (pf, FlagDu.FromBoolean flag (SynExpr.CreateConst true)) |> Some + | _ -> None + ) + |> Seq.toList + + let setFlagValue = setFlagValue flags |> SynMemberDefn.memberImplementation + { Name = record.NameOfInProgressType Fields = fields - Members = [ assembleMethod ; emptyConstructor ; processKeyValue ] |> Some + Members = [ assembleMethod ; emptyConstructor ; processKeyValue ; setFlagValue ] |> Some XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some Generics = match record.Original.Generics with @@ -1132,6 +1229,7 @@ module internal ShibaGenerator = LeafNodes = leaf |> Map.ofList Records = records |> Map.ofList Unions = unions |> Map.ofList + FlagDus = flagDus } |> Some From 4013271254109bd9caf865436f405114a6ced34c Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Wed, 16 Apr 2025 23:04:23 +0100 Subject: [PATCH 13/26] More --- ConsumePlugin/GeneratedArgs.fs | 454 ++++++++++++++++++++-- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 153 +++++++- 2 files changed, 561 insertions(+), 46 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 24122bd8..fc9d5b1e 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -88,7 +88,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -151,11 +151,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then match this.Baz with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") |> errors_.Add @@ -244,7 +254,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -307,11 +317,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then match this.Baz with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") |> errors_.Add @@ -400,7 +420,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -463,11 +483,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then match this.Baz with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") |> errors_.Add @@ -609,7 +639,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -805,13 +835,23 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) then match this.OptionalThing with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") |> errors_.Add @@ -821,7 +861,7 @@ module internal ArgParseHelpers_ConsumePlugin = true else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then match this.Baz with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") |> errors_.Add @@ -951,7 +991,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1142,13 +1182,23 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "optional-thing", System.StringComparison.OrdinalIgnoreCase) then match this.OptionalThing with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "optional-thing") |> errors_.Add @@ -1158,7 +1208,7 @@ module internal ArgParseHelpers_ConsumePlugin = true else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then match this.Baz with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz") |> errors_.Add @@ -1245,7 +1295,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1350,6 +1400,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1409,7 +1469,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1452,6 +1512,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1516,7 +1586,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1542,11 +1612,39 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Passes the key-value pair to any child records, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValueRecord_ + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> + match this.ProcessKeyValueRecord_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then match this.AndAnother with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") |> errors_.Add @@ -1615,7 +1713,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1644,6 +1742,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1708,7 +1816,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1734,11 +1842,39 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Passes the key-value pair to any child records, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValueRecord_ + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> + match this.ProcessKeyValueRecord_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then match this.AndAnother with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "and-another") |> errors_.Add @@ -1812,7 +1948,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1824,6 +1960,34 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + /// Passes the key-value pair to any child records, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValueRecord_ + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.Child.ProcessKeyValue errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> + match this.ProcessKeyValueRecord_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1874,7 +2038,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1886,6 +2050,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1938,7 +2112,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -1964,11 +2138,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "bool-var", System.StringComparison.OrdinalIgnoreCase) then match this.BoolVar with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "bool-var") |> errors_.Add @@ -2025,7 +2209,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2060,11 +2244,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then match this.DryRun with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") |> errors_.Add @@ -2135,7 +2329,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2170,11 +2364,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then match this.DryRun with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") |> errors_.Add @@ -2235,7 +2439,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2270,11 +2474,21 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "dry-run", System.StringComparison.OrdinalIgnoreCase) then match this.DryRun with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "dry-run") |> errors_.Add @@ -2347,7 +2561,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2436,13 +2650,23 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = if System.String.Equals (key, sprintf "--%s" "dont-turn-it-off", System.StringComparison.OrdinalIgnoreCase) then match this.SomeFlag with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") @@ -2456,7 +2680,7 @@ module internal ArgParseHelpers_ConsumePlugin = System.String.Equals (key, sprintf "--%s" "turn-it-on", System.StringComparison.OrdinalIgnoreCase) then match this.SomeFlag with - | Some x -> + | Some _ -> sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s / --%s" "turn-it-on" "dont-turn-it-off") @@ -2527,7 +2751,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2558,6 +2782,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2618,7 +2852,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2649,6 +2883,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2710,7 +2954,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2741,6 +2985,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2801,7 +3055,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2832,6 +3086,16 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2893,7 +3157,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Processes the key-value pair, returning Error if no key was matched. /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. - member this.ProcessKeyValue_ + member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) @@ -2928,8 +3192,124 @@ module internal ArgParseHelpers_ConsumePlugin = else Error None + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueSelf_ errors_ key value with + | Ok () -> Ok () + | Error errorFromLeaf -> Error None + /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + + /// A partially-parsed PassThru. + type internal PassThru_InProgress = + { + mutable A : ParentRecordChildPos_InProgress + } + + /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. + member this.Assemble_ + (getEnvironmentVariable : string -> string) + (positionals : Choice list) + : Result + = + let errors = ResizeArray () + let positionalConsumers = ResizeArray () + + let arg0 : ParentRecordChildPos = + match this.A.Assemble_ getEnvironmentVariable positionals with + | Ok (result, consumedPositional) -> + match consumedPositional with + | None -> () + | Some positionalConsumer -> positionalConsumers.Add positionalConsumer + + result + | Error err -> + errors.AddRange err + Unchecked.defaultof<_> + + if errors.Count = 0 then + if positionalConsumers.Count <= 1 then + Ok ( + { + A = arg0 + }, + Seq.tryExactlyOne positionalConsumers + ) + else + ("Multiple parsers consumed positional args: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error + else + errors |> Seq.toList |> Error + + static member _Empty () : PassThru_InProgress = + { + A = ParentRecordChildPos_InProgress._Empty () + } + + /// Passes the key-value pair to any child records, returning Error if no key was matched. + /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). + /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. + member this.ProcessKeyValueRecord_ + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + let errors : ResizeArray = ResizeArray () + + match this.A.ProcessKeyValue errors_ key value with + | Ok () -> Ok () + | Error e -> Error None + + member this.ProcessKeyValue + (errors_ : ResizeArray) + (key : string) + (value : string) + : Result + = + match this.ProcessKeyValueRecord_ errors_ key value with + | Ok () -> Ok () + | Error errorFromRecord -> Error None + + /// Returns false if we didn't set a value. + member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false +namespace ConsumePlugin + +open ArgParserHelpers +open System +open System.IO +open WoofWare.Myriad.Plugins + +/// Methods to parse arguments for the type PassThru +[] +module PassThruArgParse = + type internal ParseState_PassThru = + /// Ready to consume a key or positional arg + | AwaitingKey + /// Waiting to receive a value for the key we've already consumed + | AwaitingValue of key : string + + /// Extension methods for argument parsing + type PassThru with + + static member parse' (getEnvironmentVariable : string -> string) (args : string list) : PassThru = + let inProgress = ArgParseHelpers_ConsumePlugin.PassThru_InProgress._Empty () + let positionals : ResizeArray = ResizeArray () + let parseAttempt = failwith "TODO" + + match parseAttempt with + | Ok result -> result + | Error e -> e |> String.concat System.Environment.NewLine |> failwith + + static member parse (args : string list) : PassThru = + PassThru.parse' System.Environment.GetEnvironmentVariable args namespace ConsumePlugin open ArgParserHelpers diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 0c15a127..c4feedae 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -593,11 +593,67 @@ module internal ShibaGenerator = |> SynBinding.withXmlDoc (PreXmlDoc.create "Returns false if we didn't set a value.") |> SynBinding.makeInstanceMember - /// `member this.ProcessKeyValue_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// `member this.ProcessKeyValueRecord_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` /// Returns a possible error. /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do /// the parse because in fact the key decided not to take this argument); in that case we return Error None. - let private processKeyValue<'choice> (args : LeafData<'choice> list) : SynBinding = + /// + /// `args` is a list of the name of the field and the structure which is that field's contents. + let private processKeyValueRecord<'choice> (args : (string * ParsedRecordStructure<'choice>) list) : SynBinding = + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), args) + ||> List.fold (fun finalBranch (fieldName, _record) -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) + (SynExpr.sequential + [ + + finalBranch + ]) + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; fieldName ; "ProcessKeyValue" ] + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + ) + |> SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "errors" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) + ] + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValueRecord_" ] + [ + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app "Result" [ SynType.unit ; SynType.appPostfix "option" SynType.string ] + ) + |> SynBinding.withXmlDoc ( + [ + " Passes the key-value pair to any child records, returning Error if no key was matched." + " If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error()." + " This can nevertheless be a successful parse, e.g. when the key may have arity 0." + ] + |> PreXmlDoc.create' + ) + |> SynBinding.makeInstanceMember + + /// `member this.ProcessKeyValueSelf_ (errors_ : ResizeArray) (key : string) (value : string) : Result = ...` + /// Returns a possible error. + /// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do + /// the parse because in fact the key decided not to take this argument); in that case we return Error None. + let private processKeyValueSelf<'choice> (args : LeafData<'choice> list) : SynBinding = let args = args |> List.map (fun arg -> @@ -700,7 +756,7 @@ module internal ShibaGenerator = ) ) |> SynBinding.basic - [ Ident.create "this" ; Ident.create "ProcessKeyValue_" ] + [ Ident.create "this" ; Ident.create "ProcessKeyValueSelf_" ] [ SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") SynPat.annotateType SynType.string (SynPat.named "key") @@ -1105,12 +1161,81 @@ module internal ShibaGenerator = |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ record.NameOfInProgressType ]) |> SynMemberDefn.staticMember + let processKeyValueSelf = + if record.LeafNodes.IsEmpty then + None + else + record.LeafNodes + |> Map.toSeq + |> Seq.map snd + |> Seq.toList + |> processKeyValueSelf + |> SynMemberDefn.memberImplementation + |> Some + + let processKeyValueChildRecords = + if record.Records.IsEmpty then + None + else + record.Records + |> Map.toSeq + |> Seq.toList + |> processKeyValueRecord + |> SynMemberDefn.memberImplementation + |> Some + let processKeyValue = - record.LeafNodes - |> Map.toSeq - |> Seq.map snd - |> Seq.toList - |> processKeyValue + let afterErrorFromRecord = + SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None") + + let afterErrorFromLeaf = + match processKeyValueChildRecords with + | None -> afterErrorFromRecord + | Some _ -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "errorFromRecord" ]) + afterErrorFromRecord + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; "ProcessKeyValueRecord_" ] + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + + let firstMatch = + match processKeyValueSelf with + | None -> afterErrorFromLeaf + | Some _ -> + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "errorFromLeaf" ]) + afterErrorFromLeaf + ] + |> SynExpr.createMatch ( + SynExpr.createLongIdent [ "this" ; "ProcessKeyValueSelf_" ] + |> SynExpr.applyTo (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + ) + + firstMatch + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "ProcessKeyValue" ] + [ + SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") + SynPat.annotateType SynType.string (SynPat.named "key") + SynPat.annotateType SynType.string (SynPat.named "value") + ] + |> SynBinding.withReturnAnnotation (SynType.app "Result" [ SynType.unit ; SynType.option SynType.string ]) + |> SynBinding.makeInstanceMember |> SynMemberDefn.memberImplementation let flags = @@ -1144,7 +1269,17 @@ module internal ShibaGenerator = { Name = record.NameOfInProgressType Fields = fields - Members = [ assembleMethod ; emptyConstructor ; processKeyValue ; setFlagValue ] |> Some + Members = + [ + Some assembleMethod + Some emptyConstructor + processKeyValueSelf + processKeyValueChildRecords + Some processKeyValue + Some setFlagValue + ] + |> List.choose id + |> Some XmlDoc = PreXmlDoc.create $"A partially-parsed %s{record.Original.Name.idText}." |> Some Generics = match record.Original.Generics with From 54e3f17d9cd7edbcf77b08cdc468f9bfb36efa66 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 00:18:53 +0100 Subject: [PATCH 14/26] It's sort of working --- ConsumePlugin/Args.fs | 6 + ConsumePlugin/GeneratedArgs.fs | 1603 ++++++++++++++++++--- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 342 ++++- 3 files changed, 1777 insertions(+), 174 deletions(-) diff --git a/ConsumePlugin/Args.fs b/ConsumePlugin/Args.fs index 2ef25290..13477cc7 100644 --- a/ConsumePlugin/Args.fs +++ b/ConsumePlugin/Args.fs @@ -235,3 +235,9 @@ type FlagsIntoPositionalArgs' = [] DontGrabEverything : string list } + +[] +type PassThru = + { + A : ParentRecordChildPos + } diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index fc9d5b1e..1ffbaaeb 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -39,21 +39,21 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Foo with | Some result -> result | None -> - errors.Add "no value provided for Foo" + errors.Add (sprintf "Required argument '--%s' received no value" "foo") Unchecked.defaultof<_> let arg1 : string = match this.Bar with | Some result -> result | None -> - errors.Add "no value provided for Bar" + errors.Add (sprintf "Required argument '--%s' received no value" "bar") Unchecked.defaultof<_> let arg2 : bool = match this.Baz with | Some result -> result | None -> - errors.Add "no value provided for Baz" + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> let arg3 : int list = this.Rest |> Seq.toList @@ -198,31 +198,33 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Foo with | Some result -> result | None -> - errors.Add "no value provided for Foo" + errors.Add (sprintf "Required argument '--%s' received no value" "foo") Unchecked.defaultof<_> let arg1 : string = match this.Bar with | Some result -> result | None -> - errors.Add "no value provided for Bar" + errors.Add (sprintf "Required argument '--%s' received no value" "bar") Unchecked.defaultof<_> let arg2 : bool = match this.Baz with | Some result -> result | None -> - errors.Add "no value provided for Baz" + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> let arg3 : string list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> x) + |> Seq.map (fun x -> x) + |> (fun x -> Seq.append this.Rest x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -364,31 +366,33 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Foo with | Some result -> result | None -> - errors.Add "no value provided for Foo" + errors.Add (sprintf "Required argument '--%s' received no value" "foo") Unchecked.defaultof<_> let arg1 : string = match this.Bar with | Some result -> result | None -> - errors.Add "no value provided for Bar" + errors.Add (sprintf "Required argument '--%s' received no value" "bar") Unchecked.defaultof<_> let arg2 : bool = match this.Baz with | Some result -> result | None -> - errors.Add "no value provided for Baz" + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> let arg3 : int list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun x -> System.Int32.Parse x) + |> (fun x -> Seq.append this.Rest x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -537,48 +541,51 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Foo with | Some result -> result | None -> - errors.Add "no value provided for Foo" + errors.Add (sprintf "Required argument '--%s' received no value" "foo") Unchecked.defaultof<_> let arg1 : string = match this.Bar with | Some result -> result | None -> - errors.Add "no value provided for Bar" + errors.Add (sprintf "Required argument '--%s' received no value" "bar") Unchecked.defaultof<_> let arg2 : bool = match this.Baz with | Some result -> result | None -> - errors.Add "no value provided for Baz" + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> let arg3 : FileInfo = match this.SomeFile with | Some result -> result | None -> - errors.Add "no value provided for SomeFile" + errors.Add (sprintf "Required argument '--%s' received no value" "some-file") Unchecked.defaultof<_> let arg4 : DirectoryInfo = match this.SomeDirectory with | Some result -> result | None -> - errors.Add "no value provided for SomeDirectory" - Unchecked.defaultof<_> + errors.Add (sprintf "Required argument '--%s' received no value" "some-directory") + + Unchecked.defaultof<_ > let arg5 : DirectoryInfo list = this.SomeList |> Seq.toList let arg6 : int option = this.OptionalThingWithNoDefault let arg7 : int list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun x -> System.Int32.Parse x) + |> (fun x -> Seq.append this.Positionals x) + |> Seq.toList let arg8 : Choice = match this.OptionalThing with @@ -900,36 +907,37 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Foo with | Some result -> result | None -> - errors.Add "no value provided for Foo" + errors.Add (sprintf "Required argument '--%s' received no value" "foo") Unchecked.defaultof<_> let arg1 : string = match this.Bar with | Some result -> result | None -> - errors.Add "no value provided for Bar" + errors.Add (sprintf "Required argument '--%s' received no value" "bar") Unchecked.defaultof<_> let arg2 : bool = match this.Baz with | Some result -> result | None -> - errors.Add "no value provided for Baz" + errors.Add (sprintf "Required argument '--%s' received no value" "baz") Unchecked.defaultof<_> let arg3 : FileInfo = match this.SomeFile with | Some result -> result | None -> - errors.Add "no value provided for SomeFile" + errors.Add (sprintf "Required argument '--%s' received no value" "some-file") Unchecked.defaultof<_> let arg4 : DirectoryInfo = match this.SomeDirectory with | Some result -> result | None -> - errors.Add "no value provided for SomeDirectory" - Unchecked.defaultof<_> + errors.Add (sprintf "Required argument '--%s' received no value" "some-directory") + + Unchecked.defaultof<_ > let arg5 : DirectoryInfo list = this.SomeList |> Seq.toList let arg6 : int option = this.OptionalThingWithNoDefault @@ -1241,29 +1249,30 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Plain with | Some result -> result | None -> - errors.Add "no value provided for Plain" + errors.Add (sprintf "Required argument '--%s' received no value" "plain") Unchecked.defaultof<_> let arg1 : TimeSpan = match this.Invariant with | Some result -> result | None -> - errors.Add "no value provided for Invariant" + errors.Add (sprintf "Required argument '--%s' received no value" "invariant") Unchecked.defaultof<_> let arg2 : TimeSpan = match this.Exact with | Some result -> result | None -> - errors.Add "no value provided for Exact" + errors.Add (sprintf "Required argument '--%s' received no value" "exact") Unchecked.defaultof<_> let arg3 : TimeSpan = match this.InvariantExact with | Some result -> result | None -> - errors.Add "no value provided for InvariantExact" - Unchecked.defaultof<_> + errors.Add (sprintf "Required argument '--%s' received no value" "invariant-exact") + + Unchecked.defaultof<_ > if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -1433,14 +1442,14 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Thing1 with | Some result -> result | None -> - errors.Add "no value provided for Thing1" + errors.Add (sprintf "Required argument '--%s' received no value" "thing1") Unchecked.defaultof<_> let arg1 : string = match this.Thing2 with | Some result -> result | None -> - errors.Add "no value provided for Thing2" + errors.Add (sprintf "Required argument '--%s' received no value" "thing2") Unchecked.defaultof<_> if errors.Count = 0 then @@ -1557,7 +1566,7 @@ module internal ArgParseHelpers_ConsumePlugin = match this.AndAnother with | Some result -> result | None -> - errors.Add "no value provided for AndAnother" + errors.Add (sprintf "Required argument '--%s' received no value" "and-another") Unchecked.defaultof<_> if errors.Count = 0 then @@ -1675,17 +1684,19 @@ module internal ArgParseHelpers_ConsumePlugin = match this.Thing1 with | Some result -> result | None -> - errors.Add "no value provided for Thing1" + errors.Add (sprintf "Required argument '--%s' received no value" "thing1") Unchecked.defaultof<_> let arg1 : Uri list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> System.Uri x) + |> Seq.map (fun x -> System.Uri x) + |> (fun x -> Seq.append this.Thing2 x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -1787,7 +1798,7 @@ module internal ArgParseHelpers_ConsumePlugin = match this.AndAnother with | Some result -> result | None -> - errors.Add "no value provided for AndAnother" + errors.Add (sprintf "Required argument '--%s' received no value" "and-another") Unchecked.defaultof<_> if errors.Count = 0 then @@ -1915,12 +1926,14 @@ module internal ArgParseHelpers_ConsumePlugin = let arg1 : bool list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> System.Boolean.Parse x) + |> Seq.map (fun x -> System.Boolean.Parse x) + |> (fun x -> Seq.append this.AndAnother x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -2182,7 +2195,7 @@ module internal ArgParseHelpers_ConsumePlugin = match this.DryRun with | Some result -> result | None -> - errors.Add "no value provided for DryRun" + errors.Add (sprintf "Required argument '--%s' received no value" "dry-run") Unchecked.defaultof<_> if errors.Count = 0 then @@ -2525,14 +2538,15 @@ module internal ArgParseHelpers_ConsumePlugin = match this.DoTheThing with | Some result -> result | None -> - errors.Add "no value provided for DoTheThing" - Unchecked.defaultof<_> + errors.Add (sprintf "Required argument '--%s' received no value" "do-something-else") + + Unchecked.defaultof<_ > let arg1 : bool = match this.SomeFlag with | Some result -> result | None -> - errors.Add "no value provided for SomeFlag" + errors.Add (sprintf "Required argument '--%s' received no value" "turn-it-on") Unchecked.defaultof<_> if errors.Count = 0 then @@ -2713,17 +2727,19 @@ module internal ArgParseHelpers_ConsumePlugin = match this.A with | Some result -> result | None -> - errors.Add "no value provided for A" + errors.Add (sprintf "Required argument '--%s' received no value" "a") Unchecked.defaultof<_> let arg1 : string list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> x) + |> Seq.map (fun x -> x) + |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -2815,7 +2831,7 @@ module internal ArgParseHelpers_ConsumePlugin = match this.A with | Some result -> result | None -> - errors.Add "no value provided for A" + errors.Add (sprintf "Required argument '--%s' received no value" "a") Unchecked.defaultof<_> let arg1 : Choice list = @@ -2916,17 +2932,19 @@ module internal ArgParseHelpers_ConsumePlugin = match this.A with | Some result -> result | None -> - errors.Add "no value provided for A" + errors.Add (sprintf "Required argument '--%s' received no value" "a") Unchecked.defaultof<_> let arg1 : int list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun x -> System.Int32.Parse x) + |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -3018,7 +3036,7 @@ module internal ArgParseHelpers_ConsumePlugin = match this.A with | Some result -> result | None -> - errors.Add "no value provided for A" + errors.Add (sprintf "Required argument '--%s' received no value" "a") Unchecked.defaultof<_> let arg1 : Choice list = @@ -3119,17 +3137,19 @@ module internal ArgParseHelpers_ConsumePlugin = match this.A with | Some result -> result | None -> - errors.Add "no value provided for A" + errors.Add (sprintf "Required argument '--%s' received no value" "a") Unchecked.defaultof<_> let arg1 : string list = positionals - |> List.map (fun x -> + |> Seq.map (fun x -> match x with | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> List.map (fun x -> x) + |> Seq.map (fun x -> x) + |> (fun x -> Seq.append this.DontGrabEverything x) + |> Seq.toList if errors.Count = 0 then if positionalConsumers.Count <= 1 then @@ -3301,12 +3321,73 @@ module PassThruArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : PassThru = let inProgress = ArgParseHelpers_ConsumePlugin.PassThru_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_PassThru) (args : string list) = + match args with + | [] -> + match state with + | ParseState_PassThru.AwaitingKey -> () + | ParseState_PassThru.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_PassThru.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_PassThru.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_PassThru.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 |> errors_.Add + go ParseState_PassThru.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_PassThru.AwaitingKey args + | ParseState_PassThru.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_PassThru.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_PassThru.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_PassThru.AwaitingKey (arg :: args) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + go ParseState_PassThru.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : PassThru = PassThru.parse' System.Environment.GetEnvironmentVariable args @@ -3337,12 +3418,73 @@ module FlagsIntoPositionalArgs'ArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs'_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgs'.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 |> errors_.Add + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs' = FlagsIntoPositionalArgs'.parse' System.Environment.GetEnvironmentVariable args @@ -3373,12 +3515,73 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsIntChoice_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.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 |> errors_.Add + go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) + + go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice = FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args @@ -3409,12 +3612,73 @@ module FlagsIntoPositionalArgsIntArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsInt_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.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 |> errors_.Add + go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) + + go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsInt = FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args @@ -3445,12 +3709,73 @@ module FlagsIntoPositionalArgsChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsChoice_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.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 |> errors_.Add + go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) + + go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgsChoice = FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args @@ -3481,12 +3806,73 @@ module FlagsIntoPositionalArgsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = + match args with + | [] -> + match state with + | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> () + | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ key value with + | Ok () -> go ParseState_FlagsIntoPositionalArgs.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 |> errors_.Add + go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) + + go ParseState_FlagsIntoPositionalArgs.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : FlagsIntoPositionalArgs = FlagsIntoPositionalArgs.parse' System.Environment.GetEnvironmentVariable args @@ -3511,12 +3897,73 @@ module ManyLongFormsArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = let inProgress = ArgParseHelpers_ConsumePlugin.ManyLongForms_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ManyLongForms) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ManyLongForms.AwaitingKey -> () + | ParseState_ManyLongForms.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ManyLongForms.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_ManyLongForms.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ManyLongForms.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ManyLongForms.AwaitingKey args + | ParseState_ManyLongForms.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ManyLongForms.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ManyLongForms.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ManyLongForms.AwaitingKey (arg :: args) + + go ParseState_ManyLongForms.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ManyLongForms = ManyLongForms.parse' System.Environment.GetEnvironmentVariable args @@ -3547,12 +3994,73 @@ module ContainsFlagDefaultValueArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagDefaultValue_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ContainsFlagDefaultValue) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ContainsFlagDefaultValue.AwaitingKey -> () + | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ContainsFlagDefaultValue.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ContainsFlagDefaultValue.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ContainsFlagDefaultValue.AwaitingKey args + | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) + + go ParseState_ContainsFlagDefaultValue.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsFlagDefaultValue = ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args @@ -3579,12 +4087,73 @@ module ContainsFlagEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagEnvVar_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ContainsFlagEnvVar) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ContainsFlagEnvVar.AwaitingKey -> () + | ParseState_ContainsFlagEnvVar.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ContainsFlagEnvVar.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_ContainsFlagEnvVar.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ContainsFlagEnvVar.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ContainsFlagEnvVar.AwaitingKey args + | ParseState_ContainsFlagEnvVar.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) + + go ParseState_ContainsFlagEnvVar.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsFlagEnvVar = ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args @@ -3609,12 +4178,73 @@ module WithFlagDuArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = let inProgress = ArgParseHelpers_ConsumePlugin.WithFlagDu_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_WithFlagDu) (args : string list) = + match args with + | [] -> + match state with + | ParseState_WithFlagDu.AwaitingKey -> () + | ParseState_WithFlagDu.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_WithFlagDu.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_WithFlagDu.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_WithFlagDu.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_WithFlagDu.AwaitingKey args + | ParseState_WithFlagDu.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_WithFlagDu.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_WithFlagDu.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_WithFlagDu.AwaitingKey (arg :: args) + + go ParseState_WithFlagDu.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : WithFlagDu = WithFlagDu.parse' System.Environment.GetEnvironmentVariable args @@ -3641,12 +4271,73 @@ module ContainsBoolEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsBoolEnvVar_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ContainsBoolEnvVar) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ContainsBoolEnvVar.AwaitingKey -> () + | ParseState_ContainsBoolEnvVar.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ContainsBoolEnvVar.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_ContainsBoolEnvVar.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ContainsBoolEnvVar.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ContainsBoolEnvVar.AwaitingKey args + | ParseState_ContainsBoolEnvVar.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) + + go ParseState_ContainsBoolEnvVar.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ContainsBoolEnvVar = ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args @@ -3673,12 +4364,73 @@ module ChoicePositionalsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ChoicePositionals_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ChoicePositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ChoicePositionals.AwaitingKey -> () + | ParseState_ChoicePositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ChoicePositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_ChoicePositionals.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ChoicePositionals.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ChoicePositionals.AwaitingKey args + | ParseState_ChoicePositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ChoicePositionals.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ChoicePositionals.AwaitingKey (arg :: args) + + go ParseState_ChoicePositionals.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ChoicePositionals = ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args @@ -3705,12 +4457,73 @@ module ParentRecordSelfPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordSelfPos_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ParentRecordSelfPos) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ParentRecordSelfPos.AwaitingKey -> () + | ParseState_ParentRecordSelfPos.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ParentRecordSelfPos.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_ParentRecordSelfPos.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ParentRecordSelfPos.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecordSelfPos.AwaitingKey args + | ParseState_ParentRecordSelfPos.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) + + go ParseState_ParentRecordSelfPos.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecordSelfPos = ParentRecordSelfPos.parse' System.Environment.GetEnvironmentVariable args @@ -3737,12 +4550,73 @@ module ParentRecordChildPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordChildPos_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ParentRecordChildPos) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ParentRecordChildPos.AwaitingKey -> () + | ParseState_ParentRecordChildPos.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ParentRecordChildPos.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_ParentRecordChildPos.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ParentRecordChildPos.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecordChildPos.AwaitingKey args + | ParseState_ParentRecordChildPos.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) + + go ParseState_ParentRecordChildPos.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecordChildPos = ParentRecordChildPos.parse' System.Environment.GetEnvironmentVariable args @@ -3767,12 +4641,73 @@ module ParentRecordArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecord_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_ParentRecord) (args : string list) = + match args with + | [] -> + match state with + | ParseState_ParentRecord.AwaitingKey -> () + | ParseState_ParentRecord.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_ParentRecord.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_ParentRecord.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_ParentRecord.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecord.AwaitingKey args + | ParseState_ParentRecord.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_ParentRecord.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_ParentRecord.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_ParentRecord.AwaitingKey (arg :: args) + + go ParseState_ParentRecord.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : ParentRecord = ParentRecord.parse' System.Environment.GetEnvironmentVariable args @@ -3797,12 +4732,73 @@ module DatesAndTimesArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = let inProgress = ArgParseHelpers_ConsumePlugin.DatesAndTimes_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_DatesAndTimes) (args : string list) = + match args with + | [] -> + match state with + | ParseState_DatesAndTimes.AwaitingKey -> () + | ParseState_DatesAndTimes.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_DatesAndTimes.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_DatesAndTimes.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_DatesAndTimes.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_DatesAndTimes.AwaitingKey args + | ParseState_DatesAndTimes.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_DatesAndTimes.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_DatesAndTimes.AwaitingKey (arg :: args) + + go ParseState_DatesAndTimes.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith static member parse (args : string list) : DatesAndTimes = DatesAndTimes.parse' System.Environment.GetEnvironmentVariable args @@ -3826,12 +4822,69 @@ module LoadsOfTypesNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypesNoPositionals_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> () + | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) + + go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : LoadsOfTypesNoPositionals = parse' System.Environment.GetEnvironmentVariable args @@ -3853,12 +4906,69 @@ module LoadsOfTypes = let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypes_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_LoadsOfTypes) (args : string list) = + match args with + | [] -> + match state with + | ParseState_LoadsOfTypes.AwaitingKey -> () + | ParseState_LoadsOfTypes.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_LoadsOfTypes.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_LoadsOfTypes.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_LoadsOfTypes.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_LoadsOfTypes.AwaitingKey args + | ParseState_LoadsOfTypes.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_LoadsOfTypes.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_LoadsOfTypes.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_LoadsOfTypes.AwaitingKey (arg :: args) + + go ParseState_LoadsOfTypes.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : LoadsOfTypes = parse' System.Environment.GetEnvironmentVariable args @@ -3882,12 +4992,69 @@ module BasicWithIntPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicWithIntPositionals_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_BasicWithIntPositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_BasicWithIntPositionals.AwaitingKey -> () + | ParseState_BasicWithIntPositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_BasicWithIntPositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_BasicWithIntPositionals.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_BasicWithIntPositionals.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_BasicWithIntPositionals.AwaitingKey args + | ParseState_BasicWithIntPositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_BasicWithIntPositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + + go ParseState_BasicWithIntPositionals.AwaitingKey args - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : BasicWithIntPositionals = parse' System.Environment.GetEnvironmentVariable args @@ -3909,12 +5076,69 @@ module Basic = let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = let inProgress = ArgParseHelpers_ConsumePlugin.Basic_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_Basic) (args : string list) = + match args with + | [] -> + match state with + | ParseState_Basic.AwaitingKey -> () + | ParseState_Basic.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_Basic.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) + + if equals < 0 then + args |> go (ParseState_Basic.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_Basic.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_Basic.AwaitingKey args + | ParseState_Basic.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_Basic.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_Basic.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_Basic.AwaitingKey (arg :: args) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + go ParseState_Basic.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : Basic = parse' System.Environment.GetEnvironmentVariable args @@ -3938,12 +5162,69 @@ module BasicNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicNoPositionals_InProgress._Empty () - let positionals : ResizeArray = ResizeArray () - let parseAttempt = failwith "TODO" + let positionals : ResizeArray> = ResizeArray () + let errors_ = ResizeArray () + + let rec go (state : ParseState_BasicNoPositionals) (args : string list) = + match args with + | [] -> + match state with + | ParseState_BasicNoPositionals.AwaitingKey -> () + | ParseState_BasicNoPositionals.AwaitingValue key -> + if inProgress.SetFlagValue_ errors_ key then + () + else + sprintf + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + key + |> errors_.Add + | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | arg :: args -> + match state with + | ParseState_BasicNoPositionals.AwaitingKey -> + if arg.StartsWith ("--", System.StringComparison.Ordinal) then + if arg = "--help" then + "TODO" |> failwithf "Help text requested.\n%s" + else + let equals = arg.IndexOf (char 61) - match parseAttempt with - | Ok result -> result - | Error e -> e |> String.concat System.Environment.NewLine |> failwith + if equals < 0 then + args |> go (ParseState_BasicNoPositionals.AwaitingValue arg) + else + let key = arg.[0 .. equals - 1] + let value = arg.[equals + 1 ..] + + match inProgress.ProcessKeyValue errors_ 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 |> errors_.Add + go ParseState_BasicNoPositionals.AwaitingKey args + else + arg |> Choice1Of2 |> positionals.Add + go ParseState_BasicNoPositionals.AwaitingKey args + | ParseState_BasicNoPositionals.AwaitingValue key -> + match inProgress.ProcessKeyValue errors_ key arg with + | Ok () -> go ParseState_BasicNoPositionals.AwaitingKey args + | Error exc -> + if inProgress.SetFlagValue_ errors_ key then + go ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + else + key |> Choice1Of2 |> positionals.Add + go ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + + go ParseState_BasicNoPositionals.AwaitingKey args + + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with + | Ok (result, _) -> result + | Error e -> + e + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith let parse (args : string list) : BasicNoPositionals = parse' System.Environment.GetEnvironmentVariable args diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index c4feedae..91f38de2 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -863,7 +863,7 @@ module internal ShibaGenerator = let assignVariables = record.Original.Fields |> List.mapi (fun i f -> (i, f)) - |> List.collect (fun (i, SynField.SynField (attributes = attrs ; fieldType = ty ; idOpt = ident)) -> + |> List.collect (fun (i, SynField.SynField (fieldType = ty ; idOpt = ident)) -> match ident with | None -> failwith @@ -930,7 +930,8 @@ module internal ShibaGenerator = match record.LeafNodes |> Map.tryFind ident.idText with | Some leaf -> match leaf.Positional with - | Some pos -> + // TODO: account for includeFlagLike + | Some includeFlagLike -> // Positional args carried in from external argument. // TODO: register whether they came before or after separator match leaf.Acc with @@ -944,7 +945,7 @@ module internal ShibaGenerator = SynExpr.createIdent "positionals" |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction - (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLongIdent [ "Seq" ; "map" ]) (SynExpr.createLambda "x" (SynExpr.createMatch @@ -964,9 +965,21 @@ module internal ShibaGenerator = ) |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction - (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLongIdent [ "Seq" ; "map" ]) leaf.ParseFn ) + // TODO and this will have to account for the ordering + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.createLongIdent [ "Seq" ; "append" ] + |> SynExpr.applyTo ( + SynExpr.createLongIdent' + [ Ident.create "this" ; leaf.TargetConstructionField ] + ) + |> SynExpr.applyTo (SynExpr.createIdent "x")) + ) + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) | Accumulation.Optional -> failwith "unexpected: positional args should not be a list of options" | Accumulation.Choice _ -> @@ -1055,7 +1068,13 @@ module internal ShibaGenerator = [ SynExpr.callMethodArg "Add" - (SynExpr.CreateConst $"no value provided for %s{ident.idText}") + (leaf.ArgForm.[0] + |> SynExpr.applyFunction ( + SynExpr.CreateConst + "Required argument '--%s' received no value" + |> SynExpr.applyFunction (SynExpr.createIdent "sprintf") + ) + |> SynExpr.paren) (SynExpr.createIdent "errors") defaultOf ]) @@ -1564,6 +1583,277 @@ module internal ShibaGenerator = taggedMod + /// `let rec go (state : %ParseState%) (args : string list) : unit = ...` + let private mainLoop (parseState : Ident) (errorAcc : Ident) (leftoverArgs : Ident) : SynBinding = + /// `go (AwaitingValue arg) args` + let recurseValue = + SynExpr.createIdent "go" + |> SynExpr.applyTo ( + SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingValue" ]) + (SynExpr.createIdent "arg") + ) + ) + + /// `go AwaitingKey args` + let recurseKey = + (SynExpr.createIdent "go") + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.createIdent "args") + + /// `failwithf "Unable to process argument ..."` + let fail = + SynExpr.createIdent "failwithf" + |> SynExpr.applyTo (SynExpr.CreateConst "Unable to process argument %s as key %s and value %s") + |> SynExpr.applyTo (SynExpr.createIdent "arg") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value") + + let processAsPositional = + SynExpr.sequential + [ + SynExpr.createIdent "arg" + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) + + recurseKey + ] + + let notMatched = + let handleFailure = + [ + SynMatchClause.create (SynPat.named "None") fail + + SynMatchClause.create + (SynPat.nameWithArgs "Some" [ SynPat.named "msg" ]) + (SynExpr.sequential + [ + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)") + |> SynExpr.applyTo (SynExpr.createIdent "msg") + |> SynExpr.applyTo (SynExpr.createIdent "arg") + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)) + + recurseKey + ]) + ] + |> SynExpr.createMatch (SynExpr.createIdent "x") + + handleFailure + + let argStartsWithDashes = + SynExpr.createIdent "arg" + |> SynExpr.callMethodArg + "StartsWith" + (SynExpr.tuple + [ + SynExpr.CreateConst "--" + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "Ordinal" ] + ]) + + let processKey = + SynExpr.ifThenElse + argStartsWithDashes + processAsPositional + (SynExpr.ifThenElse + (SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help")) + (SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "equals" ] + [] + (SynExpr.callMethodArg "IndexOf" (SynExpr.CreateConst '=') (SynExpr.createIdent "arg")) + ] + (SynExpr.ifThenElse + (SynExpr.lessThan (SynExpr.CreateConst 0) (SynExpr.createIdent "equals")) + (SynExpr.createLet + [ + SynBinding.basic + [ Ident.create "key" ] + [] + (SynExpr.arrayIndexRange + (Some (SynExpr.CreateConst 0)) + (Some (SynExpr.minusN (SynLongIdent.createS "equals") 1)) + (SynExpr.createIdent "arg")) + SynBinding.basic + [ Ident.create "value" ] + [] + (SynExpr.arrayIndexRange + (Some (SynExpr.plus (SynExpr.createIdent "equals") (SynExpr.CreateConst 1))) + None + (SynExpr.createIdent "arg")) + ] + (SynExpr.createMatch + (SynExpr.callMethodArg + "ProcessKeyValue" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "value")) + [ + SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey + + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "x" ]) + notMatched + ])) + (SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue))) + ( //SynExpr.createIdent "helpText" + //|> SynExpr.applyTo (SynExpr.CreateConst ()) + SynExpr.CreateConst "TODO" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createIdent "failwithf") + (SynExpr.CreateConst @"Help text requested.\n%s") + ))) + + let processValue = + // During failure, we've received an optional exception message that happened when we tried to parse + // the value; it's in the variable `exc`. + // `fail` is for the case where we're genuinely emitting an error. + // If we're in `PositionalArgs true` mode, though, we won't call `fail`. + // TODO: unused?! + let fail = + [ + SynExpr.createIdent "failwithf" + |> SynExpr.applyTo ( + SynExpr.CreateConst @"Unable to process supplied arg %s. Help text follows.\n%s" + ) + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo ( + SynExpr.applyFunction (SynExpr.createIdent "helpText") (SynExpr.CreateConst ()) + |> SynExpr.paren + ) + |> SynMatchClause.create (SynPat.named "None") + + SynExpr.createIdent "msg" + |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)) + |> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "msg" ]) + ] + |> SynExpr.createMatch (SynExpr.createIdent "exc") + + let onFailure = + [ + SynExpr.createIdent "key" + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) + + SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")) + ] + |> SynExpr.sequential + + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) + (SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.createIdent "go") + (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])) + (SynExpr.createIdent "args")) + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "exc" ]) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.callMethodArg + "SetFlagValue_" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "key")) + onFailure + (SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")))) + ] + |> SynExpr.createMatch ( + SynExpr.applyFunction + (SynExpr.applyFunction + (SynExpr.callMethodArg + "ProcessKeyValue" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "key")) + (SynExpr.createIdent "arg") + ) + + let argBody = + [ + SynMatchClause.create + (SynPat.identWithArgs [ parseState ; Ident.create "AwaitingKey" ] (SynArgPats.create [])) + processKey + SynMatchClause.create + (SynPat.identWithArgs + [ parseState ; Ident.create "AwaitingValue" ] + (SynArgPats.createNamed [ "key" ])) + processValue + ] + |> SynExpr.createMatch (SynExpr.createIdent "state") + + let body = + let trailingArgMessage = + SynExpr.createIdent "sprintf" + |> SynExpr.applyTo ( + SynExpr.CreateConst + "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." + ) + |> SynExpr.applyTo (SynExpr.createIdent "key") + + [ + SynMatchClause.create + SynPat.emptyList + (SynExpr.createMatch + (SynExpr.createIdent "state") + [ + SynMatchClause.create + (SynPat.identWithArgs [ parseState ; Ident.create "AwaitingKey" ] (SynArgPats.create [])) + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.identWithArgs + [ parseState ; Ident.create "AwaitingValue" ] + (SynArgPats.createNamed [ "key" ])) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.callMethodArg + "SetFlagValue_" + (SynExpr.createIdent "errors_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "key")) + (trailingArgMessage + |> SynExpr.pipeThroughFunction ( + SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc) + )) + (SynExpr.CreateConst ())) + ]) + SynMatchClause.create + (SynPat.listCons (SynPat.createConst (SynConst.Create "--")) (SynPat.named "rest")) + (SynExpr.callMethodArg + "AddRange" + (SynExpr.paren ( + SynExpr.createIdent "rest" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createIdent "Choice2Of2") + ) + )) + (SynExpr.createIdent' leftoverArgs)) + SynMatchClause.create (SynPat.listCons (SynPat.named "arg") (SynPat.named "args")) argBody + ] + |> SynExpr.createMatch (SynExpr.createIdent "args") + + let args = + [ + SynPat.named "state" + |> SynPat.annotateType (SynType.createLongIdent [ parseState ]) + SynPat.named "args" + |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) + ] + + SynBinding.basic [ Ident.create "go" ] args body + |> SynBinding.withRecursion true + // The type for which we're generating args may refer to any of the supplied records/unions. let createModule (opens : SynOpenDeclTarget list) @@ -1646,22 +1936,46 @@ module internal ShibaGenerator = (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.createLongIdent [ "System" ; "Environment" ; "NewLine" ]) ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.plus (SynExpr.CreateConst "Errors during parse!\\n") (SynExpr.createIdent "x")) + ) |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") let parsePrime = [ - SynMatchClause.create - (SynPat.nameWithArgs "Ok" [ SynPat.named "result" ]) - (SynExpr.createIdent "result") - SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) raiseErrors + SynExpr.applyFunction + (SynExpr.createIdent "go") + (SynExpr.createLongIdent' [ parseStateIdent ; Ident.create "AwaitingKey" ]) + |> SynExpr.applyTo (SynExpr.createIdent "args") + + [ + SynMatchClause.create + (SynPat.nameWithArgs "Ok" [ SynPat.tuple [ SynPat.named "result" ; SynPat.anon ] ]) + (SynExpr.createIdent "result") + SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) raiseErrors + ] + |> SynExpr.createMatch ( + SynExpr.callMethodArg + "Assemble_" + (SynExpr.createIdent "getEnvironmentVariable") + (SynExpr.createIdent "inProgress") + |> SynExpr.applyTo ( + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.paren + ) + ) ] - |> SynExpr.createMatch (SynExpr.createIdent "parseAttempt") + |> SynExpr.sequential |> SynExpr.createLet [ SynBinding.basic - [ Ident.create "parseAttempt" ] + [ Ident.create "errors_" ] [] - (SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO")) + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + mainLoop parseStateIdent (Ident.create "errors_") (Ident.create "positionals") ] |> SynExpr.createLet [ @@ -1678,7 +1992,9 @@ module internal ShibaGenerator = [ Ident.create "positionals" ] [] (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) - |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) + |> SynBinding.withReturnAnnotation ( + SynType.app "ResizeArray" [ SynType.app "Choice" [ SynType.string ; SynType.string ] ] + ) ] |> SynBinding.basic [ Ident.create "parse'" ] From c14f89f807b24fc06124b05c848e85d377c2ab56 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 11:05:08 +0100 Subject: [PATCH 15/26] Fix another test --- ConsumePlugin/GeneratedArgs.fs | 168 ++++++++++++++++++++++ WoofWare.Myriad.Plugins/ShibaGenerator.fs | 14 +- 2 files changed, 179 insertions(+), 3 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 1ffbaaeb..3803d03b 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -3381,6 +3381,14 @@ module PassThruArgParse = go ParseState_PassThru.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3478,6 +3486,14 @@ module FlagsIntoPositionalArgs'ArgParse = go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3575,6 +3591,14 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3672,6 +3696,14 @@ module FlagsIntoPositionalArgsIntArgParse = go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3769,6 +3801,14 @@ module FlagsIntoPositionalArgsChoiceArgParse = go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3866,6 +3906,14 @@ module FlagsIntoPositionalArgsArgParse = go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -3957,6 +4005,14 @@ module ManyLongFormsArgParse = go ParseState_ManyLongForms.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4054,6 +4110,14 @@ module ContainsFlagDefaultValueArgParse = go ParseState_ContainsFlagDefaultValue.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4147,6 +4211,14 @@ module ContainsFlagEnvVarArgParse = go ParseState_ContainsFlagEnvVar.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4238,6 +4310,14 @@ module WithFlagDuArgParse = go ParseState_WithFlagDu.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4331,6 +4411,14 @@ module ContainsBoolEnvVarArgParse = go ParseState_ContainsBoolEnvVar.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4424,6 +4512,14 @@ module ChoicePositionalsArgParse = go ParseState_ChoicePositionals.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4517,6 +4613,14 @@ module ParentRecordSelfPosArgParse = go ParseState_ParentRecordSelfPos.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4610,6 +4714,14 @@ module ParentRecordChildPosArgParse = go ParseState_ParentRecordChildPos.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4701,6 +4813,14 @@ module ParentRecordArgParse = go ParseState_ParentRecord.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4792,6 +4912,14 @@ module DatesAndTimesArgParse = go ParseState_DatesAndTimes.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4878,6 +5006,14 @@ module LoadsOfTypesNoPositionals = go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -4962,6 +5098,14 @@ module LoadsOfTypes = go ParseState_LoadsOfTypes.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -5048,6 +5192,14 @@ module BasicWithIntPositionals = go ParseState_BasicWithIntPositionals.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -5132,6 +5284,14 @@ module Basic = go ParseState_Basic.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> @@ -5218,6 +5378,14 @@ module BasicNoPositionals = go ParseState_BasicNoPositionals.AwaitingKey args + if 0 = errors_.Count then + () + else + errors_ + |> String.concat System.Environment.NewLine + |> (fun x -> "Errors during parse!\n" + x) + |> failwith + match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, _) -> result | Error e -> diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 91f38de2..9eeae299 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1929,8 +1929,8 @@ module internal ShibaGenerator = SynPat.named "args" |> SynPat.annotateType (SynType.appPostfix "list" SynType.string) - let raiseErrors = - SynExpr.createIdent "e" + let raiseErrors (errorIdent : Ident) = + SynExpr.createIdent' errorIdent |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) @@ -1950,11 +1950,19 @@ module internal ShibaGenerator = (SynExpr.createLongIdent' [ parseStateIdent ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createIdent "args") + SynExpr.ifThenElse + (SynExpr.dotGet "Count" (SynExpr.createIdent "errors_") + |> SynExpr.equals (SynExpr.CreateConst 0)) + (raiseErrors (Ident.create "errors_")) + (SynExpr.CreateConst ()) + [ SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.tuple [ SynPat.named "result" ; SynPat.anon ] ]) (SynExpr.createIdent "result") - SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) raiseErrors + SynMatchClause.create + (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) + (raiseErrors (Ident.create "e")) ] |> SynExpr.createMatch ( SynExpr.callMethodArg From 55a3876610dce55f50bf789a32e76043184e7dea Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 11:13:37 +0100 Subject: [PATCH 16/26] More --- ConsumePlugin/GeneratedArgs.fs | 126 ++++++++++++++++++---- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 12 ++- 2 files changed, 115 insertions(+), 23 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 3803d03b..7182a1db 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -3390,7 +3390,11 @@ module PassThruArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -3495,7 +3499,11 @@ module FlagsIntoPositionalArgs'ArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -3600,7 +3608,11 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -3705,7 +3717,11 @@ module FlagsIntoPositionalArgsIntArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -3810,7 +3826,11 @@ module FlagsIntoPositionalArgsChoiceArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -3915,7 +3935,11 @@ module FlagsIntoPositionalArgsArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4014,7 +4038,11 @@ module ManyLongFormsArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4119,7 +4147,11 @@ module ContainsFlagDefaultValueArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4220,7 +4252,11 @@ module ContainsFlagEnvVarArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4319,7 +4355,11 @@ module WithFlagDuArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4420,7 +4460,11 @@ module ContainsBoolEnvVarArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4521,7 +4565,11 @@ module ChoicePositionalsArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4622,7 +4670,11 @@ module ParentRecordSelfPosArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4723,7 +4775,11 @@ module ParentRecordChildPosArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4822,7 +4878,11 @@ module ParentRecordArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -4921,7 +4981,11 @@ module DatesAndTimesArgParse = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -5015,7 +5079,11 @@ module LoadsOfTypesNoPositionals = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -5107,7 +5175,11 @@ module LoadsOfTypes = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -5201,7 +5273,11 @@ module BasicWithIntPositionals = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -5293,7 +5369,11 @@ module Basic = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine @@ -5387,7 +5467,11 @@ module BasicNoPositionals = |> failwith match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with - | Ok (result, _) -> result + | Ok (result, posConsumer) -> + if positionals.Count > 0 && posConsumer.IsNone then + failwith "TODO" + else + result | Error e -> e |> String.concat System.Environment.NewLine diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 9eeae299..c59e6771 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1958,8 +1958,16 @@ module internal ShibaGenerator = [ SynMatchClause.create - (SynPat.nameWithArgs "Ok" [ SynPat.tuple [ SynPat.named "result" ; SynPat.anon ] ]) - (SynExpr.createIdent "result") + (SynPat.nameWithArgs + "Ok" + [ SynPat.tuple [ SynPat.named "result" ; SynPat.named "posConsumer" ] ]) + (SynExpr.ifThenElse + (SynExpr.booleanAnd + (SynExpr.dotGet "Count" (SynExpr.createIdent "positionals") + |> SynExpr.greaterThan (SynExpr.CreateConst 0)) + (SynExpr.dotGet "IsNone" (SynExpr.createIdent "posConsumer"))) + (SynExpr.createIdent "result") + (SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO"))) SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) (raiseErrors (Ident.create "e")) From 51991cab74ff9a9756fdea7c101935c0b73926da Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 11:45:34 +0100 Subject: [PATCH 17/26] Fix another test --- ConsumePlugin/GeneratedArgs.fs | 29 +++++++-- .../TestArgParser/TestArgParser.fs | 2 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 59 ++++++++++++++++++- 3 files changed, 84 insertions(+), 6 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 7182a1db..4606d99a 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -2098,7 +2098,14 @@ module internal ArgParseHelpers_ConsumePlugin = Choice2Of2 ( "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable - |> (fun x -> System.Boolean.Parse x) + |> (fun x -> + if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then + true + else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then + false + else + x |> (fun x -> System.Boolean.Parse x) + ) ) if errors.Count = 0 then @@ -2311,10 +2318,24 @@ module internal ArgParseHelpers_ConsumePlugin = "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> - if System.Boolean.Parse x = Consts.FALSE then - DryRunMode.Wet + 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 - DryRunMode.Dry + x + |> (fun x -> + if System.Boolean.Parse x = Consts.FALSE then + DryRunMode.Wet + else + DryRunMode.Dry + ) ) ) diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index 5b2b4d0b..dde77cb3 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -444,7 +444,7 @@ Required argument '--exact' received no value""" ] |> List.map TestCaseData - [] + [] let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) = let getEnvVar (s : string) = s |> shouldEqual "CONSUMEPLUGIN_THINGS" diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index c59e6771..b4842a7b 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -139,6 +139,13 @@ module internal ShibaGenerator = ArgForm : SynExpr list /// Name of the field of the in-progress record storing this leaf. TargetConstructionField : Ident + /// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different: + /// we should lie to the user about the value of the cases there. + /// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g. + /// "0" instead of "false", we need to know if we're reading a bool. + /// In that case, `boolCases` is Some, and contains the construction of the flag (or boolean, in which case + /// you get no data). + BoolCases : Choice option } /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all @@ -211,9 +218,16 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = None } |> ParseFunctionSpec.Leaf | PrimitiveType pt -> + let isBoolLike = + if pt |> List.map _.idText = [ "System" ; "Boolean" ] then + Some (Choice2Of2 ()) + else + identifyAsFlag flagDus ty |> Option.map Choice1Of2 + { ParseFn = SynExpr.createLambda @@ -226,6 +240,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = isBoolLike } |> ParseFunctionSpec.Leaf | Uri -> @@ -239,6 +254,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = None } |> ParseFunctionSpec.Leaf | TimeSpan -> @@ -301,6 +317,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = None } |> ParseFunctionSpec.Leaf | FileInfo -> @@ -316,6 +333,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = None } |> ParseFunctionSpec.Leaf | DirectoryInfo -> @@ -331,6 +349,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = None } |> ParseFunctionSpec.Leaf | OptionType eltTy -> @@ -501,6 +520,7 @@ module internal ShibaGenerator = Positional = positional ArgForm = longForms TargetConstructionField = fieldName + BoolCases = Some (Choice1Of2 flagDu) } |> ParseFunctionSpec.Leaf @@ -1020,6 +1040,43 @@ module internal ShibaGenerator = | _ -> failwith "unexpected: positional arguments should be a list" | None -> + let parseFn = + match leaf.BoolCases with + | Some boolLike -> + let trueCase, falseCase = + match boolLike with + | Choice2Of2 () -> SynExpr.CreateConst true, SynExpr.CreateConst false + | Choice1Of2 flag -> + FlagDu.FromBoolean flag (SynExpr.CreateConst true), + FlagDu.FromBoolean flag (SynExpr.CreateConst false) + + // We permit environment variables to be populated with 0 and 1 as well. + SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.CreateConst "1" + SynExpr.createLongIdent + [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + (SynExpr.ifThenElse + (SynExpr.applyFunction + (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ]) + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.CreateConst "0" + SynExpr.createLongIdent + [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ] + ])) + (SynExpr.createIdent "x" |> SynExpr.pipeThroughFunction leaf.ParseFn) + falseCase) + trueCase + |> SynExpr.createLambda "x" + | None -> leaf.ParseFn + let extract = match leaf.Acc with | Accumulation.ChoicePositional choice -> failwith "TODO" @@ -1040,7 +1097,7 @@ module internal ShibaGenerator = |> SynExpr.pipeThroughFunction ( SynExpr.createIdent "getEnvironmentVariable" ) - |> SynExpr.pipeThroughFunction leaf.ParseFn + |> SynExpr.pipeThroughFunction parseFn | ArgumentDefaultSpec.FunctionCall name -> SynExpr.callMethod name.idText From a82ece0f6c537a2e194ba61ec075ee61ef826ab6 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 12:41:55 +0100 Subject: [PATCH 18/26] Plumb through indices --- ConsumePlugin/GeneratedArgs.fs | 933 ++++++++++++---------- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 152 +++- 2 files changed, 657 insertions(+), 428 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 4606d99a..f7a1c43a 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -29,7 +29,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -89,13 +89,14 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> this.Rest.Add + value |> (fun x -> System.Int32.Parse x) |> (fun x -> x) |> this.Rest.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then match this.Foo with @@ -152,12 +153,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -182,13 +184,13 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Bar : string option mutable Baz : bool option mutable Foo : int option - mutable Rest : ResizeArray + mutable Rest : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -222,8 +224,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) |> (fun x -> Seq.append this.Rest x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -257,13 +261,14 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> this.Rest.Add + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.Rest.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then match this.Foo with @@ -320,12 +325,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -350,13 +356,13 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Bar : string option mutable Baz : bool option mutable Foo : int option - mutable Rest : ResizeArray + mutable Rest : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -390,8 +396,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) |> (fun x -> Seq.append this.Rest x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -425,13 +433,18 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> this.Rest.Add + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.Rest.Add + () |> Ok else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then match this.Foo with @@ -488,12 +501,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -521,7 +535,7 @@ module internal ArgParseHelpers_ConsumePlugin = mutable Foo : int option mutable OptionalThing : bool option mutable OptionalThingWithNoDefault : int option - mutable Positionals : ResizeArray + mutable Positionals : ResizeArray mutable SomeDirectory : DirectoryInfo option mutable SomeFile : FileInfo option mutable SomeList : ResizeArray @@ -531,7 +545,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -583,8 +597,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) |> (fun x -> Seq.append this.Positionals x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList let arg8 : Choice = @@ -647,6 +663,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -678,7 +695,11 @@ module internal ArgParseHelpers_ConsumePlugin = else if System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.IO.DirectoryInfo x) |> this.SomeList.Add + value + |> (fun x -> System.IO.DirectoryInfo x) + |> (fun x -> x) + |> this.SomeList.Add + () |> Ok else if System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) @@ -721,7 +742,11 @@ module internal ArgParseHelpers_ConsumePlugin = else if System.String.Equals (key, sprintf "--%s" "positionals", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> this.Positionals.Add + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.Positionals.Add + () |> Ok else if System.String.Equals ( @@ -843,12 +868,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -897,7 +923,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1000,6 +1026,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1031,7 +1058,11 @@ module internal ArgParseHelpers_ConsumePlugin = else if System.String.Equals (key, sprintf "--%s" "some-list", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.IO.DirectoryInfo x) |> this.SomeList.Add + value + |> (fun x -> System.IO.DirectoryInfo x) + |> (fun x -> x) + |> this.SomeList.Add + () |> Ok else if System.String.Equals (key, sprintf "--%s" "some-file", System.StringComparison.OrdinalIgnoreCase) @@ -1191,12 +1222,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -1239,7 +1271,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1305,6 +1337,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1410,12 +1443,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -1432,7 +1466,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1479,6 +1513,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1522,12 +1557,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -1544,7 +1580,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1596,6 +1632,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1625,6 +1662,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueRecord_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1632,20 +1670,21 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors : ResizeArray = ResizeArray () - match this.Child.ProcessKeyValue errors_ key value with + match this.Child.ProcessKeyValue argNum_ errors_ key value with | Ok () -> Ok () | Error e -> Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> - match this.ProcessKeyValueRecord_ errors_ key value with + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromRecord -> Error None @@ -1668,13 +1707,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal ChildRecordWithPositional_InProgress = { mutable Thing1 : int option - mutable Thing2 : ResizeArray + mutable Thing2 : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1694,8 +1733,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> System.Uri x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Uri x), argNum_) |> (fun x -> Seq.append this.Thing2 x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -1725,13 +1766,14 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "thing2", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Uri x) |> this.Thing2.Add + value |> (fun x -> System.Uri x) |> (fun x -> x, argNum_) |> this.Thing2.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "thing1", System.StringComparison.OrdinalIgnoreCase) then match this.Thing1 with @@ -1754,12 +1796,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -1776,7 +1819,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1828,6 +1871,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1857,6 +1901,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueRecord_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1864,20 +1909,21 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors : ResizeArray = ResizeArray () - match this.Child.ProcessKeyValue errors_ key value with + match this.Child.ProcessKeyValue argNum_ errors_ key value with | Ok () -> Ok () | Error e -> Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> - match this.ProcessKeyValueRecord_ errors_ key value with + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromRecord -> Error None @@ -1899,14 +1945,14 @@ module internal ArgParseHelpers_ConsumePlugin = /// A partially-parsed ParentRecordSelfPos. type internal ParentRecordSelfPos_InProgress = { - mutable AndAnother : ResizeArray + mutable AndAnother : ResizeArray mutable Child : ChildRecord_InProgress } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -1931,8 +1977,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> System.Boolean.Parse x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Boolean.Parse x), argNum_) |> (fun x -> Seq.append this.AndAnother x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -1962,13 +2010,18 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "and-another", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Boolean.Parse x) |> this.AndAnother.Add + value + |> (fun x -> System.Boolean.Parse x) + |> (fun x -> x, argNum_) + |> this.AndAnother.Add + () |> Ok else Error None @@ -1977,6 +2030,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueRecord_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -1984,20 +2038,21 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors : ResizeArray = ResizeArray () - match this.Child.ProcessKeyValue errors_ key value with + match this.Child.ProcessKeyValue argNum_ errors_ key value with | Ok () -> Ok () | Error e -> Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> - match this.ProcessKeyValueRecord_ errors_ key value with + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromRecord -> Error None @@ -2007,13 +2062,13 @@ module internal ArgParseHelpers_ConsumePlugin = /// A partially-parsed ChoicePositionals. type internal ChoicePositionals_InProgress = { - mutable Args : ResizeArray + mutable Args : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2023,8 +2078,8 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> List.map (fun x -> match x with - | Choice1Of2 x -> (fun x -> x) x |> Choice1Of2 - | Choice2Of2 x -> (fun x -> x) x |> Choice2Of2 + | Choice1Of2 (x, argPos) -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 ) if errors.Count = 0 then @@ -2052,24 +2107,26 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = if System.String.Equals (key, sprintf "--%s" "args", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> this.Args.Add + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.Args.Add () |> Ok else Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2085,7 +2142,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2133,6 +2190,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2159,12 +2217,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2192,7 +2251,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2230,6 +2289,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2265,12 +2325,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2304,7 +2365,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2364,6 +2425,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2399,12 +2461,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2438,7 +2501,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2474,6 +2537,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2509,12 +2573,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2549,7 +2614,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2597,6 +2662,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2686,12 +2752,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2732,13 +2799,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal FlagsIntoPositionalArgs_InProgress = { mutable A : string option - mutable GrabEverything : ResizeArray + mutable GrabEverything : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2758,8 +2825,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -2789,6 +2858,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2797,7 +2867,7 @@ module internal ArgParseHelpers_ConsumePlugin = if System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> this.GrabEverything.Add + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.GrabEverything.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then match this.A with @@ -2820,12 +2890,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2836,13 +2907,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal FlagsIntoPositionalArgsChoice_InProgress = { mutable A : string option - mutable GrabEverything : ResizeArray + mutable GrabEverything : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2859,8 +2930,8 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> List.map (fun x -> match x with - | Choice1Of2 x -> (fun x -> x) x |> Choice1Of2 - | Choice2Of2 x -> (fun x -> x) x |> Choice2Of2 + | Choice1Of2 (x, argPos) -> (fun x -> x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 ) if errors.Count = 0 then @@ -2890,6 +2961,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -2898,7 +2970,7 @@ module internal ArgParseHelpers_ConsumePlugin = if System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> x) |> this.GrabEverything.Add + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.GrabEverything.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then match this.A with @@ -2921,12 +2993,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -2937,13 +3010,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal FlagsIntoPositionalArgsInt_InProgress = { mutable A : string option - mutable GrabEverything : ResizeArray + mutable GrabEverything : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -2963,8 +3036,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> System.Int32.Parse x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) |> (fun x -> Seq.append this.GrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -2994,6 +3069,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -3002,7 +3078,11 @@ module internal ArgParseHelpers_ConsumePlugin = if System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> this.GrabEverything.Add + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.GrabEverything.Add + () |> Ok else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then match this.A with @@ -3025,12 +3105,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -3041,13 +3122,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal FlagsIntoPositionalArgsIntChoice_InProgress = { mutable A : string option - mutable GrabEverything : ResizeArray + mutable GrabEverything : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -3064,8 +3145,8 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> List.map (fun x -> match x with - | Choice1Of2 x -> (fun x -> System.Int32.Parse x) x |> Choice1Of2 - | Choice2Of2 x -> (fun x -> System.Int32.Parse x) x |> Choice2Of2 + | Choice1Of2 (x, argPos) -> (fun x -> System.Int32.Parse x) x |> Choice1Of2 + | Choice2Of2 (x, argPos) -> (fun x -> System.Int32.Parse x) x |> Choice2Of2 ) if errors.Count = 0 then @@ -3095,6 +3176,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -3103,7 +3185,11 @@ module internal ArgParseHelpers_ConsumePlugin = if System.String.Equals (key, sprintf "--%s" "grab-everything", System.StringComparison.OrdinalIgnoreCase) then - value |> (fun x -> System.Int32.Parse x) |> this.GrabEverything.Add + value + |> (fun x -> System.Int32.Parse x) + |> (fun x -> x, argNum_) + |> this.GrabEverything.Add + () |> Ok else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then match this.A with @@ -3126,12 +3212,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -3142,13 +3229,13 @@ module internal ArgParseHelpers_ConsumePlugin = type internal FlagsIntoPositionalArgs'_InProgress = { mutable A : string option - mutable DontGrabEverything : ResizeArray + mutable DontGrabEverything : ResizeArray } /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -3168,8 +3255,10 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice1Of2 x -> x | Choice2Of2 x -> x ) - |> Seq.map (fun x -> x) + |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) |> (fun x -> Seq.append this.DontGrabEverything x) + |> Seq.sortBy snd + |> Seq.map fst |> Seq.toList if errors.Count = 0 then @@ -3199,6 +3288,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueSelf_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -3211,7 +3301,7 @@ module internal ArgParseHelpers_ConsumePlugin = System.StringComparison.OrdinalIgnoreCase ) then - value |> (fun x -> x) |> this.DontGrabEverything.Add + value |> (fun x -> x) |> (fun x -> x, argNum_) |> this.DontGrabEverything.Add () |> Ok else if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then match this.A with @@ -3234,12 +3324,13 @@ module internal ArgParseHelpers_ConsumePlugin = Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueSelf_ errors_ key value with + match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromLeaf -> Error None @@ -3255,7 +3346,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args. member this.Assemble_ (getEnvironmentVariable : string -> string) - (positionals : Choice list) + (positionals : Choice list) : Result = let errors = ResizeArray () @@ -3298,6 +3389,7 @@ module internal ArgParseHelpers_ConsumePlugin = /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(). /// This can nevertheless be a successful parse, e.g. when the key may have arity 0. member this.ProcessKeyValueRecord_ + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) @@ -3305,17 +3397,18 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors : ResizeArray = ResizeArray () - match this.A.ProcessKeyValue errors_ key value with + match this.A.ProcessKeyValue argNum_ errors_ key value with | Ok () -> Ok () | Error e -> Error None member this.ProcessKeyValue + (argNum_ : int) (errors_ : ResizeArray) (key : string) (value : string) : Result = - match this.ProcessKeyValueRecord_ errors_ key value with + match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () | Error errorFromRecord -> Error None @@ -3342,10 +3435,10 @@ module PassThruArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : PassThru = let inProgress = ArgParseHelpers_ConsumePlugin.PassThru_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_PassThru) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_PassThru) (args : string list) = match args with | [] -> match state with @@ -3358,7 +3451,8 @@ module PassThruArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_PassThru.AwaitingKey -> @@ -3369,13 +3463,13 @@ module PassThruArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_PassThru.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_PassThru.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_PassThru.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_PassThru.AwaitingKey args | Error x -> match x with | None -> @@ -3386,21 +3480,21 @@ module PassThruArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_PassThru.AwaitingKey args + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_PassThru.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args | ParseState_PassThru.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_PassThru.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_PassThru.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_PassThru.AwaitingKey (arg :: args) + go argNum_ ParseState_PassThru.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_PassThru.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_PassThru.AwaitingKey (arg :: args) - go ParseState_PassThru.AwaitingKey args + go 0 ParseState_PassThru.AwaitingKey args if 0 = errors_.Count then () @@ -3451,10 +3545,10 @@ module FlagsIntoPositionalArgs'ArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs'_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgs') (args : string list) = match args with | [] -> match state with @@ -3467,7 +3561,8 @@ module FlagsIntoPositionalArgs'ArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgs'.AwaitingKey -> @@ -3478,13 +3573,13 @@ module FlagsIntoPositionalArgs'ArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | Error x -> match x with | None -> @@ -3495,21 +3590,21 @@ module FlagsIntoPositionalArgs'ArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | ParseState_FlagsIntoPositionalArgs'.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) + go argNum_ ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) - go ParseState_FlagsIntoPositionalArgs'.AwaitingKey args + go 0 ParseState_FlagsIntoPositionalArgs'.AwaitingKey args if 0 = errors_.Count then () @@ -3560,10 +3655,10 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsIntChoice_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) = match args with | [] -> match state with @@ -3576,7 +3671,8 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> @@ -3587,13 +3683,15 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + args + |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | Error x -> match x with | None -> @@ -3604,21 +3702,25 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + + go + (argNum_ + 1) + ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey + args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) + go argNum_ ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args) - go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args + go 0 ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args if 0 = errors_.Count then () @@ -3669,10 +3771,10 @@ module FlagsIntoPositionalArgsIntArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsInt_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) = match args with | [] -> match state with @@ -3685,7 +3787,8 @@ module FlagsIntoPositionalArgsIntArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> @@ -3696,13 +3799,14 @@ module FlagsIntoPositionalArgsIntArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) + args + |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | Error x -> match x with | None -> @@ -3713,21 +3817,21 @@ module FlagsIntoPositionalArgsIntArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) + go argNum_ ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args) - go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args + go 0 ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args if 0 = errors_.Count then () @@ -3778,10 +3882,10 @@ module FlagsIntoPositionalArgsChoiceArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgsChoice_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) = match args with | [] -> match state with @@ -3794,7 +3898,8 @@ module FlagsIntoPositionalArgsChoiceArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> @@ -3805,13 +3910,15 @@ module FlagsIntoPositionalArgsChoiceArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) + args + |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | Error x -> match x with | None -> @@ -3822,21 +3929,21 @@ module FlagsIntoPositionalArgsChoiceArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) + go argNum_ ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args) - go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args + go 0 ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args if 0 = errors_.Count then () @@ -3887,10 +3994,10 @@ module FlagsIntoPositionalArgsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.FlagsIntoPositionalArgs_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_FlagsIntoPositionalArgs) (args : string list) = match args with | [] -> match state with @@ -3903,7 +4010,8 @@ module FlagsIntoPositionalArgsArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_FlagsIntoPositionalArgs.AwaitingKey -> @@ -3914,13 +4022,13 @@ module FlagsIntoPositionalArgsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args | Error x -> match x with | None -> @@ -3931,21 +4039,21 @@ module FlagsIntoPositionalArgsArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args | ParseState_FlagsIntoPositionalArgs.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_FlagsIntoPositionalArgs.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) + go argNum_ ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) - go ParseState_FlagsIntoPositionalArgs.AwaitingKey args + go 0 ParseState_FlagsIntoPositionalArgs.AwaitingKey args if 0 = errors_.Count then () @@ -3990,10 +4098,10 @@ module ManyLongFormsArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ManyLongForms = let inProgress = ArgParseHelpers_ConsumePlugin.ManyLongForms_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ManyLongForms) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ManyLongForms) (args : string list) = match args with | [] -> match state with @@ -4006,7 +4114,8 @@ module ManyLongFormsArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ManyLongForms.AwaitingKey -> @@ -4017,13 +4126,13 @@ module ManyLongFormsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ManyLongForms.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ManyLongForms.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args | Error x -> match x with | None -> @@ -4034,21 +4143,21 @@ module ManyLongFormsArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ManyLongForms.AwaitingKey args + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ManyLongForms.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args | ParseState_ManyLongForms.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ManyLongForms.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ManyLongForms.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ManyLongForms.AwaitingKey (arg :: args) + go argNum_ ParseState_ManyLongForms.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ManyLongForms.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey (arg :: args) - go ParseState_ManyLongForms.AwaitingKey args + go 0 ParseState_ManyLongForms.AwaitingKey args if 0 = errors_.Count then () @@ -4099,10 +4208,10 @@ module ContainsFlagDefaultValueArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagDefaultValue_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsFlagDefaultValue) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsFlagDefaultValue) (args : string list) = match args with | [] -> match state with @@ -4115,7 +4224,8 @@ module ContainsFlagDefaultValueArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsFlagDefaultValue.AwaitingKey -> @@ -4126,13 +4236,13 @@ module ContainsFlagDefaultValueArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args | Error x -> match x with | None -> @@ -4143,21 +4253,21 @@ module ContainsFlagDefaultValueArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args | ParseState_ContainsFlagDefaultValue.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsFlagDefaultValue.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) + go argNum_ ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args) - go ParseState_ContainsFlagDefaultValue.AwaitingKey args + go 0 ParseState_ContainsFlagDefaultValue.AwaitingKey args if 0 = errors_.Count then () @@ -4204,10 +4314,10 @@ module ContainsFlagEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsFlagEnvVar_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsFlagEnvVar) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsFlagEnvVar) (args : string list) = match args with | [] -> match state with @@ -4220,7 +4330,8 @@ module ContainsFlagEnvVarArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsFlagEnvVar.AwaitingKey -> @@ -4231,13 +4342,13 @@ module ContainsFlagEnvVarArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsFlagEnvVar.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ContainsFlagEnvVar.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args | Error x -> match x with | None -> @@ -4248,21 +4359,21 @@ module ContainsFlagEnvVarArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args | ParseState_ContainsFlagEnvVar.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsFlagEnvVar.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) + go argNum_ ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args) - go ParseState_ContainsFlagEnvVar.AwaitingKey args + go 0 ParseState_ContainsFlagEnvVar.AwaitingKey args if 0 = errors_.Count then () @@ -4307,10 +4418,10 @@ module WithFlagDuArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu = let inProgress = ArgParseHelpers_ConsumePlugin.WithFlagDu_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_WithFlagDu) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_WithFlagDu) (args : string list) = match args with | [] -> match state with @@ -4323,7 +4434,8 @@ module WithFlagDuArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_WithFlagDu.AwaitingKey -> @@ -4334,13 +4446,13 @@ module WithFlagDuArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_WithFlagDu.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_WithFlagDu.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args | Error x -> match x with | None -> @@ -4351,21 +4463,21 @@ module WithFlagDuArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_WithFlagDu.AwaitingKey args + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_WithFlagDu.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args | ParseState_WithFlagDu.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_WithFlagDu.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_WithFlagDu.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_WithFlagDu.AwaitingKey (arg :: args) + go argNum_ ParseState_WithFlagDu.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_WithFlagDu.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey (arg :: args) - go ParseState_WithFlagDu.AwaitingKey args + go 0 ParseState_WithFlagDu.AwaitingKey args if 0 = errors_.Count then () @@ -4412,10 +4524,10 @@ module ContainsBoolEnvVarArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ContainsBoolEnvVar_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ContainsBoolEnvVar) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ContainsBoolEnvVar) (args : string list) = match args with | [] -> match state with @@ -4428,7 +4540,8 @@ module ContainsBoolEnvVarArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ContainsBoolEnvVar.AwaitingKey -> @@ -4439,13 +4552,13 @@ module ContainsBoolEnvVarArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ContainsBoolEnvVar.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ContainsBoolEnvVar.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args | Error x -> match x with | None -> @@ -4456,21 +4569,21 @@ module ContainsBoolEnvVarArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args | ParseState_ContainsBoolEnvVar.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ContainsBoolEnvVar.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) + go argNum_ ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args) - go ParseState_ContainsBoolEnvVar.AwaitingKey args + go 0 ParseState_ContainsBoolEnvVar.AwaitingKey args if 0 = errors_.Count then () @@ -4517,10 +4630,10 @@ module ChoicePositionalsArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ChoicePositionals_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ChoicePositionals) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ChoicePositionals) (args : string list) = match args with | [] -> match state with @@ -4533,7 +4646,8 @@ module ChoicePositionalsArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ChoicePositionals.AwaitingKey -> @@ -4544,13 +4658,13 @@ module ChoicePositionalsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ChoicePositionals.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ChoicePositionals.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args | Error x -> match x with | None -> @@ -4561,21 +4675,21 @@ module ChoicePositionalsArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ChoicePositionals.AwaitingKey args + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ChoicePositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args | ParseState_ChoicePositionals.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ChoicePositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ChoicePositionals.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ChoicePositionals.AwaitingKey (arg :: args) + go argNum_ ParseState_ChoicePositionals.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ChoicePositionals.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey (arg :: args) - go ParseState_ChoicePositionals.AwaitingKey args + go 0 ParseState_ChoicePositionals.AwaitingKey args if 0 = errors_.Count then () @@ -4622,10 +4736,10 @@ module ParentRecordSelfPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordSelfPos_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecordSelfPos) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecordSelfPos) (args : string list) = match args with | [] -> match state with @@ -4638,7 +4752,8 @@ module ParentRecordSelfPosArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecordSelfPos.AwaitingKey -> @@ -4649,13 +4764,13 @@ module ParentRecordSelfPosArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecordSelfPos.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ParentRecordSelfPos.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args | Error x -> match x with | None -> @@ -4666,21 +4781,21 @@ module ParentRecordSelfPosArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecordSelfPos.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args | ParseState_ParentRecordSelfPos.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ParentRecordSelfPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecordSelfPos.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) + go argNum_ ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey (arg :: args) - go ParseState_ParentRecordSelfPos.AwaitingKey args + go 0 ParseState_ParentRecordSelfPos.AwaitingKey args if 0 = errors_.Count then () @@ -4727,10 +4842,10 @@ module ParentRecordChildPosArgParse = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecordChildPos_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecordChildPos) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecordChildPos) (args : string list) = match args with | [] -> match state with @@ -4743,7 +4858,8 @@ module ParentRecordChildPosArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecordChildPos.AwaitingKey -> @@ -4754,13 +4870,13 @@ module ParentRecordChildPosArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecordChildPos.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ParentRecordChildPos.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args | Error x -> match x with | None -> @@ -4771,21 +4887,21 @@ module ParentRecordChildPosArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ParentRecordChildPos.AwaitingKey args + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecordChildPos.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args | ParseState_ParentRecordChildPos.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ParentRecordChildPos.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecordChildPos.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) + go argNum_ ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey (arg :: args) - go ParseState_ParentRecordChildPos.AwaitingKey args + go 0 ParseState_ParentRecordChildPos.AwaitingKey args if 0 = errors_.Count then () @@ -4830,10 +4946,10 @@ module ParentRecordArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ParentRecord = let inProgress = ArgParseHelpers_ConsumePlugin.ParentRecord_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_ParentRecord) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_ParentRecord) (args : string list) = match args with | [] -> match state with @@ -4846,7 +4962,8 @@ module ParentRecordArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_ParentRecord.AwaitingKey -> @@ -4857,13 +4974,13 @@ module ParentRecordArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_ParentRecord.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_ParentRecord.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args | Error x -> match x with | None -> @@ -4874,21 +4991,21 @@ module ParentRecordArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_ParentRecord.AwaitingKey args + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecord.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args | ParseState_ParentRecord.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_ParentRecord.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_ParentRecord.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_ParentRecord.AwaitingKey (arg :: args) + go argNum_ ParseState_ParentRecord.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_ParentRecord.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey (arg :: args) - go ParseState_ParentRecord.AwaitingKey args + go 0 ParseState_ParentRecord.AwaitingKey args if 0 = errors_.Count then () @@ -4933,10 +5050,10 @@ module DatesAndTimesArgParse = static member parse' (getEnvironmentVariable : string -> string) (args : string list) : DatesAndTimes = let inProgress = ArgParseHelpers_ConsumePlugin.DatesAndTimes_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_DatesAndTimes) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_DatesAndTimes) (args : string list) = match args with | [] -> match state with @@ -4949,7 +5066,8 @@ module DatesAndTimesArgParse = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> + positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_DatesAndTimes.AwaitingKey -> @@ -4960,13 +5078,13 @@ module DatesAndTimesArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_DatesAndTimes.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_DatesAndTimes.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args | Error x -> match x with | None -> @@ -4977,21 +5095,21 @@ module DatesAndTimesArgParse = value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_DatesAndTimes.AwaitingKey args + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_DatesAndTimes.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args | ParseState_DatesAndTimes.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_DatesAndTimes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_DatesAndTimes.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_DatesAndTimes.AwaitingKey (arg :: args) + go argNum_ ParseState_DatesAndTimes.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_DatesAndTimes.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey (arg :: args) - go ParseState_DatesAndTimes.AwaitingKey args + go 0 ParseState_DatesAndTimes.AwaitingKey args if 0 = errors_.Count then () @@ -5035,10 +5153,10 @@ module LoadsOfTypesNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypesNoPositionals_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_LoadsOfTypesNoPositionals) (args : string list) = match args with | [] -> match state with @@ -5051,7 +5169,7 @@ module LoadsOfTypesNoPositionals = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_LoadsOfTypesNoPositionals.AwaitingKey -> @@ -5062,34 +5180,35 @@ module LoadsOfTypesNoPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) + args + |> go (argNum_ + 1) (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | Error x -> match x with | None -> failwithf "Unable to process argument %s as key %s and value %s" arg key value | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | ParseState_LoadsOfTypesNoPositionals.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) + go argNum_ ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey (arg :: args) - go ParseState_LoadsOfTypesNoPositionals.AwaitingKey args + go 0 ParseState_LoadsOfTypesNoPositionals.AwaitingKey args if 0 = errors_.Count then () @@ -5131,10 +5250,10 @@ module LoadsOfTypes = let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes = let inProgress = ArgParseHelpers_ConsumePlugin.LoadsOfTypes_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_LoadsOfTypes) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_LoadsOfTypes) (args : string list) = match args with | [] -> match state with @@ -5147,7 +5266,7 @@ module LoadsOfTypes = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_LoadsOfTypes.AwaitingKey -> @@ -5158,34 +5277,34 @@ module LoadsOfTypes = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_LoadsOfTypes.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_LoadsOfTypes.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_LoadsOfTypes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 |> errors_.Add - go ParseState_LoadsOfTypes.AwaitingKey args + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_LoadsOfTypes.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args | ParseState_LoadsOfTypes.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_LoadsOfTypes.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_LoadsOfTypes.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_LoadsOfTypes.AwaitingKey (arg :: args) + go argNum_ ParseState_LoadsOfTypes.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_LoadsOfTypes.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey (arg :: args) - go ParseState_LoadsOfTypes.AwaitingKey args + go 0 ParseState_LoadsOfTypes.AwaitingKey args if 0 = errors_.Count then () @@ -5229,10 +5348,10 @@ module BasicWithIntPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicWithIntPositionals_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_BasicWithIntPositionals) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_BasicWithIntPositionals) (args : string list) = match args with | [] -> match state with @@ -5245,7 +5364,7 @@ module BasicWithIntPositionals = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_BasicWithIntPositionals.AwaitingKey -> @@ -5256,34 +5375,34 @@ module BasicWithIntPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_BasicWithIntPositionals.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_BasicWithIntPositionals.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_BasicWithIntPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 |> errors_.Add - go ParseState_BasicWithIntPositionals.AwaitingKey args + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_BasicWithIntPositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args | ParseState_BasicWithIntPositionals.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_BasicWithIntPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_BasicWithIntPositionals.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + go argNum_ ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey (arg :: args) - go ParseState_BasicWithIntPositionals.AwaitingKey args + go 0 ParseState_BasicWithIntPositionals.AwaitingKey args if 0 = errors_.Count then () @@ -5325,10 +5444,10 @@ module Basic = let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic = let inProgress = ArgParseHelpers_ConsumePlugin.Basic_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_Basic) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_Basic) (args : string list) = match args with | [] -> match state with @@ -5341,7 +5460,7 @@ module Basic = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_Basic.AwaitingKey -> @@ -5352,34 +5471,34 @@ module Basic = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_Basic.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_Basic.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_Basic.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 |> errors_.Add - go ParseState_Basic.AwaitingKey args + go (argNum_ + 1) ParseState_Basic.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_Basic.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_Basic.AwaitingKey args | ParseState_Basic.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_Basic.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_Basic.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_Basic.AwaitingKey (arg :: args) + go argNum_ ParseState_Basic.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_Basic.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_Basic.AwaitingKey (arg :: args) - go ParseState_Basic.AwaitingKey args + go 0 ParseState_Basic.AwaitingKey args if 0 = errors_.Count then () @@ -5423,10 +5542,10 @@ module BasicNoPositionals = let inProgress = ArgParseHelpers_ConsumePlugin.BasicNoPositionals_InProgress._Empty () - let positionals : ResizeArray> = ResizeArray () + let positionals : ResizeArray> = ResizeArray () let errors_ = ResizeArray () - let rec go (state : ParseState_BasicNoPositionals) (args : string list) = + let rec go (argNum_ : int) (state : ParseState_BasicNoPositionals) (args : string list) = match args with | [] -> match state with @@ -5439,7 +5558,7 @@ module BasicNoPositionals = "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args." key |> errors_.Add - | "--" :: rest -> positionals.AddRange (rest |> Seq.map Choice2Of2) + | "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2) | arg :: args -> match state with | ParseState_BasicNoPositionals.AwaitingKey -> @@ -5450,34 +5569,34 @@ module BasicNoPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (ParseState_BasicNoPositionals.AwaitingValue arg) + args |> go (argNum_ + 1) (ParseState_BasicNoPositionals.AwaitingValue arg) else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] - match inProgress.ProcessKeyValue errors_ key value with - | Ok () -> go ParseState_BasicNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key value with + | Ok () -> go (argNum_ + 1) 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 |> errors_.Add - go ParseState_BasicNoPositionals.AwaitingKey args + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args else - arg |> Choice1Of2 |> positionals.Add - go ParseState_BasicNoPositionals.AwaitingKey args + (arg, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args | ParseState_BasicNoPositionals.AwaitingValue key -> - match inProgress.ProcessKeyValue errors_ key arg with - | Ok () -> go ParseState_BasicNoPositionals.AwaitingKey args + match inProgress.ProcessKeyValue argNum_ errors_ key arg with + | Ok () -> go argNum_ ParseState_BasicNoPositionals.AwaitingKey args | Error exc -> if inProgress.SetFlagValue_ errors_ key then - go ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + go argNum_ ParseState_BasicNoPositionals.AwaitingKey (arg :: args) else - key |> Choice1Of2 |> positionals.Add - go ParseState_BasicNoPositionals.AwaitingKey (arg :: args) + (key, argNum_) |> Choice1Of2 |> positionals.Add + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey (arg :: args) - go ParseState_BasicNoPositionals.AwaitingKey args + go 0 ParseState_BasicNoPositionals.AwaitingKey args if 0 = errors_.Count then () diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index b4842a7b..d8d13e67 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -636,6 +636,7 @@ module internal ShibaGenerator = ] |> SynExpr.createMatch ( SynExpr.createLongIdent [ "this" ; fieldName ; "ProcessKeyValue" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") |> SynExpr.applyTo (SynExpr.createIdent "errors_") |> SynExpr.applyTo (SynExpr.createIdent "key") |> SynExpr.applyTo (SynExpr.createIdent "value") @@ -652,6 +653,7 @@ module internal ShibaGenerator = |> SynBinding.basic [ Ident.create "this" ; Ident.create "ProcessKeyValueRecord_" ] [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") SynPat.annotateType SynType.string (SynPat.named "key") SynPat.annotateType SynType.string (SynPat.named "value") @@ -739,6 +741,15 @@ module internal ShibaGenerator = [ SynExpr.createIdent "value" |> SynExpr.pipeThroughFunction arg.ParseFn + // Annotate the positional with arg index info + |> SynExpr.pipeThroughFunction ( + match arg.Positional with + | None -> SynExpr.createLambda "x" (SynExpr.createIdent "x") + | Some _ -> + SynExpr.createLambda + "x" + (SynExpr.tupleNoParen [ SynExpr.createIdent "x" ; SynExpr.createIdent "argNum_" ]) + ) |> SynExpr.pipeThroughFunction ( SynExpr.createLongIdent' [ Ident.create "this" ; arg.TargetConstructionField ; Ident.create "Add" ] @@ -778,6 +789,7 @@ module internal ShibaGenerator = |> SynBinding.basic [ Ident.create "this" ; Ident.create "ProcessKeyValueSelf_" ] [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") SynPat.annotateType SynType.string (SynPat.named "key") SynPat.annotateType SynType.string (SynPat.named "value") @@ -806,7 +818,14 @@ module internal ShibaGenerator = | Accumulation.Choice _ -> SynType.option data.TypeAfterParse, true | Accumulation.ChoicePositional _ -> failwith "TODO" | Accumulation.List acc -> - SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ], false + match data.Positional with + | Some _ -> + SynType.app' + (SynType.createLongIdent' [ "ResizeArray" ]) + [ SynType.tupleNoParen [ data.TypeAfterParse ; SynType.int ] |> Option.get ], + false + | None -> + SynType.app' (SynType.createLongIdent' [ "ResizeArray" ]) [ data.TypeAfterParse ], false | Accumulation.Optional -> SynType.option data.TypeAfterParse, true | Accumulation.Required -> SynType.option data.TypeAfterParse, true @@ -984,11 +1003,40 @@ module internal ShibaGenerator = ])) ) |> SynExpr.pipeThroughFunction ( + let body = + SynExpr.tupleNoParen + [ + SynExpr.pipeThroughFunction + leaf.ParseFn + (SynExpr.createIdent "str") + SynExpr.createIdent "argNum_" + ] + SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) - leaf.ParseFn + (SynExpr.Lambda ( + false, + false, + SynSimplePats.create + [ + SynSimplePat.createId (Ident.create "str") + SynSimplePat.createId (Ident.create "argNum_") + ], + body, + Some ( + [ + SynPat.tuple + [ SynPat.named "str" ; SynPat.named "argNum_" ] + ], + body + ), + range0, + { + ArrowRange = Some range0 + } + ) + |> SynExpr.paren) ) - // TODO and this will have to account for the ordering |> SynExpr.pipeThroughFunction ( SynExpr.createLambda "x" @@ -999,6 +1047,16 @@ module internal ShibaGenerator = ) |> SynExpr.applyTo (SynExpr.createIdent "x")) ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "sortBy" ]) + (SynExpr.createIdent "snd") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createIdent "fst") + ) |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) | Accumulation.Optional -> failwith "unexpected: positional args should not be a list of options" @@ -1018,7 +1076,14 @@ module internal ShibaGenerator = SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Choice1Of2" ] - (SynArgPats.createNamed [ "x" ])) + (SynArgPats.create + [ + SynPat.tuple + [ + SynPat.named "x" + SynPat.named "argPos" + ] + ])) (SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") @@ -1028,7 +1093,14 @@ module internal ShibaGenerator = SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Choice2Of2" ] - (SynArgPats.createNamed [ "x" ])) + (SynArgPats.create + [ + SynPat.tuple + [ + SynPat.named "x" + SynPat.named "argPos" + ] + ])) (SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") @@ -1190,7 +1262,14 @@ module internal ShibaGenerator = (SynType.funFromDomain SynType.string SynType.string) (SynPat.named "getEnvironmentVariable") SynPat.annotateType - (SynType.list (SynType.app "Choice" [ SynType.string ; SynType.string ])) + (SynType.list ( + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + )) (SynPat.named "positionals") ] |> SynBinding.withReturnAnnotation ( @@ -1278,6 +1357,7 @@ module internal ShibaGenerator = ] |> SynExpr.createMatch ( SynExpr.createLongIdent [ "this" ; "ProcessKeyValueRecord_" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") |> SynExpr.applyTo (SynExpr.createIdent "errors_") |> SynExpr.applyTo (SynExpr.createIdent "key") |> SynExpr.applyTo (SynExpr.createIdent "value") @@ -1297,6 +1377,7 @@ module internal ShibaGenerator = ] |> SynExpr.createMatch ( SynExpr.createLongIdent [ "this" ; "ProcessKeyValueSelf_" ] + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") |> SynExpr.applyTo (SynExpr.createIdent "errors_") |> SynExpr.applyTo (SynExpr.createIdent "key") |> SynExpr.applyTo (SynExpr.createIdent "value") @@ -1306,6 +1387,7 @@ module internal ShibaGenerator = |> SynBinding.basic [ Ident.create "this" ; Ident.create "ProcessKeyValue" ] [ + SynPat.annotateType SynType.int (SynPat.named "argNum_") SynPat.annotateType (SynType.app "ResizeArray" [ SynType.string ]) (SynPat.named "errors_") SynPat.annotateType SynType.string (SynPat.named "key") SynPat.annotateType SynType.string (SynPat.named "value") @@ -1642,9 +1724,10 @@ module internal ShibaGenerator = /// `let rec go (state : %ParseState%) (args : string list) : unit = ...` let private mainLoop (parseState : Ident) (errorAcc : Ident) (leftoverArgs : Ident) : SynBinding = - /// `go (AwaitingValue arg) args` + /// `go (argNum + 1) (AwaitingValue arg)` let recurseValue = SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1))) |> SynExpr.applyTo ( SynExpr.paren ( SynExpr.applyFunction @@ -1653,9 +1736,10 @@ module internal ShibaGenerator = ) ) - /// `go AwaitingKey args` + /// `go (argNum + 1) AwaitingKey args` let recurseKey = (SynExpr.createIdent "go") + |> SynExpr.applyTo (SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1))) |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createIdent "args") @@ -1670,7 +1754,7 @@ module internal ShibaGenerator = let processAsPositional = SynExpr.sequential [ - SynExpr.createIdent "arg" + SynExpr.tuple [ SynExpr.createIdent "arg" ; SynExpr.createIdent "argNum_" ] |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) @@ -1744,8 +1828,9 @@ module internal ShibaGenerator = (SynExpr.createMatch (SynExpr.callMethodArg "ProcessKeyValue" - (SynExpr.createIdent "errors_") + (SynExpr.createIdent "argNum_") (SynExpr.createIdent "inProgress") + |> SynExpr.applyTo (SynExpr.createIdent "errors_") |> SynExpr.applyTo (SynExpr.createIdent "key") |> SynExpr.applyTo (SynExpr.createIdent "value")) [ @@ -1792,11 +1877,14 @@ module internal ShibaGenerator = let onFailure = [ - SynExpr.createIdent "key" + SynExpr.tuple [ SynExpr.createIdent "key" ; SynExpr.createIdent "argNum_" ] |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) SynExpr.createIdent "go" + |> SynExpr.applyTo ( + SynExpr.paren (SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1)) + ) |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")) ] @@ -1807,7 +1895,7 @@ module internal ShibaGenerator = (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) (SynExpr.applyFunction (SynExpr.applyFunction - (SynExpr.createIdent "go") + (SynExpr.createIdent "go" |> SynExpr.applyTo (SynExpr.createIdent "argNum_")) (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])) (SynExpr.createIdent "args")) SynMatchClause.create @@ -1821,18 +1909,19 @@ module internal ShibaGenerator = (SynExpr.createIdent "key")) onFailure (SynExpr.createIdent "go" + |> SynExpr.applyTo (SynExpr.createIdent "argNum_") |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")))) ] |> SynExpr.createMatch ( SynExpr.applyFunction - (SynExpr.applyFunction - (SynExpr.callMethodArg - "ProcessKeyValue" - (SynExpr.createIdent "errors_") - (SynExpr.createIdent "inProgress")) - (SynExpr.createIdent "key")) - (SynExpr.createIdent "arg") + (SynExpr.callMethodArg + "ProcessKeyValue" + (SynExpr.createIdent "argNum_") + (SynExpr.createIdent "inProgress")) + (SynExpr.createIdent "errors_") + |> SynExpr.applyTo (SynExpr.createIdent "key") + |> SynExpr.applyTo (SynExpr.createIdent "arg") ) let argBody = @@ -1889,6 +1978,17 @@ module internal ShibaGenerator = "AddRange" (SynExpr.paren ( SynExpr.createIdent "rest" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.tuple + [ + SynExpr.createIdent "x" + SynExpr.plus (SynExpr.createIdent "argNum_") (SynExpr.CreateConst 1) + ])) + ) |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) @@ -1902,6 +2002,7 @@ module internal ShibaGenerator = let args = [ + SynPat.named "argNum_" |> SynPat.annotateType SynType.int SynPat.named "state" |> SynPat.annotateType (SynType.createLongIdent [ parseState ]) SynPat.named "args" @@ -2003,7 +2104,7 @@ module internal ShibaGenerator = let parsePrime = [ SynExpr.applyFunction - (SynExpr.createIdent "go") + (SynExpr.applyFunction (SynExpr.createIdent "go") (SynExpr.CreateConst 0)) (SynExpr.createLongIdent' [ parseStateIdent ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createIdent "args") @@ -2066,7 +2167,16 @@ module internal ShibaGenerator = [] (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) |> SynBinding.withReturnAnnotation ( - SynType.app "ResizeArray" [ SynType.app "Choice" [ SynType.string ; SynType.string ] ] + SynType.app + "ResizeArray" + [ + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + ] ) ] |> SynBinding.basic From 573d410416542c35e1034d40650106e810450443 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 12:47:48 +0100 Subject: [PATCH 19/26] Fix another test --- ConsumePlugin/GeneratedArgs.fs | 6 ++ WoofWare.Myriad.Plugins/ShibaGenerator.fs | 112 +++++++++++----------- 2 files changed, 64 insertions(+), 54 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index f7a1c43a..b8fcb428 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -2075,6 +2075,8 @@ module internal ArgParseHelpers_ConsumePlugin = let positionalConsumers = ResizeArray () let arg0 : Choice list = + positionalConsumers.Add (sprintf "--%s" "args") + positionals |> List.map (fun x -> match x with @@ -2927,6 +2929,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : Choice list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + positionals |> List.map (fun x -> match x with @@ -3142,6 +3146,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : Choice list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + positionals |> List.map (fun x -> match x with diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index d8d13e67..e21bff4d 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -87,6 +87,9 @@ type private ParseFunction<'acc> = module internal ShibaGenerator = //let log (s : string) = System.IO.File.AppendAllText ("/tmp/myriad.log", s + "\n") + let private choice1Of2 = SynExpr.createIdent "Choice1Of2" + let private choice2Of2 = SynExpr.createIdent "Choice2Of2" + type RecognisedType = | Union of UnionType | Record of RecordType @@ -1064,51 +1067,56 @@ module internal ShibaGenerator = failwith "internal error: positional args, if Choicey, should be a ChoicePositional" | Accumulation.ChoicePositional attrContents -> - SynExpr.createIdent "positionals" - |> SynExpr.pipeThroughFunction ( - SynExpr.applyFunction - (SynExpr.createLongIdent [ "List" ; "map" ]) - (SynExpr.createLambda - "x" - (SynExpr.createMatch - (SynExpr.createIdent "x") - [ - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Choice1Of2" ] - (SynArgPats.create - [ - SynPat.tuple - [ - SynPat.named "x" - SynPat.named "argPos" - ] - ])) - (SynExpr.applyFunction - leaf.ParseFn - (SynExpr.createIdent "x") - |> SynExpr.pipeThroughFunction ( - SynExpr.createIdent "Choice1Of2" - )) - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Choice2Of2" ] - (SynArgPats.create - [ - SynPat.tuple - [ - SynPat.named "x" - SynPat.named "argPos" - ] - ])) - (SynExpr.applyFunction - leaf.ParseFn - (SynExpr.createIdent "x") - |> SynExpr.pipeThroughFunction ( - SynExpr.createIdent "Choice2Of2" - )) - ])) - ) + [ + SynExpr.callMethodArg + "Add" + leaf.HumanReadableArgForm + (SynExpr.createIdent "positionalConsumers") + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLambda + "x" + (SynExpr.createMatch + (SynExpr.createIdent "x") + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ + SynPat.named "x" + SynPat.named "argPos" + ] + ])) + (SynExpr.applyFunction + leaf.ParseFn + (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction choice1Of2) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ + SynPat.named "x" + SynPat.named "argPos" + ] + ])) + (SynExpr.applyFunction + leaf.ParseFn + (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction ( + SynExpr.createIdent "Choice2Of2" + )) + ])) + ) + ] + |> SynExpr.sequential | _ -> failwith "unexpected: positional arguments should be a list" | None -> @@ -1158,9 +1166,7 @@ module internal ShibaGenerator = (SynPat.identWithArgs [ Ident.create "Some" ] (SynArgPats.create [ SynPat.named "result" ])) - (SynExpr.applyFunction - (SynExpr.createIdent "Choice1Of2") - (SynExpr.createIdent "result")) + (SynExpr.applyFunction choice1Of2 (SynExpr.createIdent "result")) SynMatchClause.create (SynPat.identWithArgs [ Ident.create "None" ] (SynArgPats.create [])) (match choice with @@ -1175,7 +1181,7 @@ module internal ShibaGenerator = name.idText (SynExpr.createIdent' record.Original.Name) |> SynExpr.paren - |> SynExpr.applyFunction (SynExpr.createIdent "Choice2Of2")) + |> SynExpr.applyFunction choice2Of2) ] |> SynExpr.createMatch (SynExpr.dotGet ident.idText (SynExpr.createIdent "this")) | Accumulation.List acc -> @@ -1755,7 +1761,7 @@ module internal ShibaGenerator = SynExpr.sequential [ SynExpr.tuple [ SynExpr.createIdent "arg" ; SynExpr.createIdent "argNum_" ] - |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.pipeThroughFunction choice1Of2 |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) recurseKey @@ -1878,7 +1884,7 @@ module internal ShibaGenerator = let onFailure = [ SynExpr.tuple [ SynExpr.createIdent "key" ; SynExpr.createIdent "argNum_" ] - |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.pipeThroughFunction choice1Of2 |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ]) SynExpr.createIdent "go" @@ -1990,9 +1996,7 @@ module internal ShibaGenerator = ])) ) |> SynExpr.pipeThroughFunction ( - SynExpr.applyFunction - (SynExpr.createLongIdent [ "Seq" ; "map" ]) - (SynExpr.createIdent "Choice2Of2") + SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) choice2Of2 ) )) (SynExpr.createIdent' leftoverArgs)) From d3d50cae7c39d1e8001b7b734cfdf68c80e60c5b Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 15:49:12 +0100 Subject: [PATCH 20/26] Fix another test --- ConsumePlugin/GeneratedArgs.fs | 357 ++++++++++++------ .../TestArgParser/TestArgParser.fs | 6 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 343 +++++++++-------- 3 files changed, 424 insertions(+), 282 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index b8fcb428..ce7f2b7a 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -218,6 +218,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg3 : string list = + positionalConsumers.Add (sprintf "--%s" "rest") + positionals |> Seq.map (fun x -> match x with @@ -390,6 +392,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg3 : int list = + positionalConsumers.Add (sprintf "--%s" "rest") + positionals |> Seq.map (fun x -> match x with @@ -591,6 +595,8 @@ module internal ArgParseHelpers_ConsumePlugin = let arg6 : int option = this.OptionalThingWithNoDefault let arg7 : int list = + positionalConsumers.Add (sprintf "--%s" "positionals") + positionals |> Seq.map (fun x -> match x with @@ -1727,6 +1733,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : Uri list = + positionalConsumers.Add (sprintf "--%s" "thing2") + positionals |> Seq.map (fun x -> match x with @@ -1971,6 +1979,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : bool list = + positionalConsumers.Add (sprintf "--%s" "and-another") + positionals |> Seq.map (fun x -> match x with @@ -2821,6 +2831,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : string list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + positionals |> Seq.map (fun x -> match x with @@ -3034,6 +3046,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : int list = + positionalConsumers.Add (sprintf "--%s" "grab-everything") + positionals |> Seq.map (fun x -> match x with @@ -3255,6 +3269,8 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_> let arg1 : string list = + positionalConsumers.Add (sprintf "--%s" "dont-grab-everything") + positionals |> Seq.map (fun x -> match x with @@ -3479,11 +3495,8 @@ module PassThruArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_PassThru.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_PassThru.AwaitingKey args @@ -3513,7 +3526,15 @@ module PassThruArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -3589,11 +3610,8 @@ module FlagsIntoPositionalArgs'ArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs'.AwaitingKey args @@ -3623,7 +3641,15 @@ module FlagsIntoPositionalArgs'ArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -3701,11 +3727,12 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + + go + (argNum_ + 1) + ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey + args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add @@ -3739,7 +3766,15 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -3816,11 +3851,8 @@ module FlagsIntoPositionalArgsIntArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args @@ -3850,7 +3882,15 @@ module FlagsIntoPositionalArgsIntArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -3928,11 +3968,8 @@ module FlagsIntoPositionalArgsChoiceArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args @@ -3962,7 +3999,15 @@ module FlagsIntoPositionalArgsChoiceArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4038,11 +4083,8 @@ module FlagsIntoPositionalArgsArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_FlagsIntoPositionalArgs.AwaitingKey args @@ -4072,7 +4114,15 @@ module FlagsIntoPositionalArgsArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4142,11 +4192,8 @@ module ManyLongFormsArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ManyLongForms.AwaitingKey args @@ -4176,7 +4223,15 @@ module ManyLongFormsArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4252,11 +4307,8 @@ module ContainsFlagDefaultValueArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ContainsFlagDefaultValue.AwaitingKey args @@ -4286,7 +4338,15 @@ module ContainsFlagDefaultValueArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4358,11 +4418,8 @@ module ContainsFlagEnvVarArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ContainsFlagEnvVar.AwaitingKey args @@ -4392,7 +4449,15 @@ module ContainsFlagEnvVarArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4462,11 +4527,8 @@ module WithFlagDuArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_WithFlagDu.AwaitingKey args @@ -4496,7 +4558,15 @@ module WithFlagDuArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4568,11 +4638,8 @@ module ContainsBoolEnvVarArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ContainsBoolEnvVar.AwaitingKey args @@ -4602,7 +4669,15 @@ module ContainsBoolEnvVarArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4674,11 +4749,8 @@ module ChoicePositionalsArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ChoicePositionals.AwaitingKey args @@ -4708,7 +4780,15 @@ module ChoicePositionalsArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4780,11 +4860,8 @@ module ParentRecordSelfPosArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ParentRecordSelfPos.AwaitingKey args @@ -4814,7 +4891,15 @@ module ParentRecordSelfPosArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4886,11 +4971,8 @@ module ParentRecordChildPosArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ParentRecordChildPos.AwaitingKey args @@ -4920,7 +5002,15 @@ module ParentRecordChildPosArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -4990,11 +5080,8 @@ module ParentRecordArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_ParentRecord.AwaitingKey args @@ -5024,7 +5111,15 @@ module ParentRecordArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5094,11 +5189,8 @@ module DatesAndTimesArgParse = | Error x -> match x with | None -> - failwithf - "Unable to process argument %s as key %s and value %s" - arg - key - value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_DatesAndTimes.AwaitingKey args @@ -5128,7 +5220,15 @@ module DatesAndTimesArgParse = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5197,7 +5297,8 @@ module LoadsOfTypesNoPositionals = | Error x -> match x with | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_LoadsOfTypesNoPositionals.AwaitingKey args @@ -5227,7 +5328,15 @@ module LoadsOfTypesNoPositionals = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5293,7 +5402,8 @@ module LoadsOfTypes = | Error x -> match x with | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_LoadsOfTypes.AwaitingKey args @@ -5323,7 +5433,15 @@ module LoadsOfTypes = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5391,7 +5509,8 @@ module BasicWithIntPositionals = | Error x -> match x with | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_BasicWithIntPositionals.AwaitingKey args @@ -5421,7 +5540,15 @@ module BasicWithIntPositionals = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5487,7 +5614,8 @@ module Basic = | Error x -> match x with | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_Basic.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_Basic.AwaitingKey args @@ -5517,7 +5645,15 @@ module Basic = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> @@ -5585,7 +5721,8 @@ module BasicNoPositionals = | Error x -> match x with | None -> - failwithf "Unable to process argument %s as key %s and value %s" arg key value + positionals.Add (Choice1Of2 (arg, argNum_)) + go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args | Some msg -> sprintf "%s (at arg %s)" msg arg |> errors_.Add go (argNum_ + 1) ParseState_BasicNoPositionals.AwaitingKey args @@ -5615,7 +5752,15 @@ module BasicNoPositionals = match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with | Ok (result, posConsumer) -> if positionals.Count > 0 && posConsumer.IsNone then - failwith "TODO" + positionals + |> Seq.map (fun choiceValue -> + match choiceValue with + | Choice1Of2 (arg, _) -> arg + | Choice2Of2 (arg, _) -> arg + ) + |> String.concat " " + |> sprintf "Parse error: The following arguments were not consumed: %s" + |> failwith else result | Error e -> diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index dde77cb3..e4643bb3 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -79,7 +79,7 @@ module TestArgParser = exc.Message |> shouldEqual - """Unable to process supplied arg --non-existent. Help text follows. + """Parse error: The following arguments were not consumed: --non-existent. to process supplied arg --non-existent. Help text follows. --foo int32 : This is a foo! --bar string --baz bool @@ -692,7 +692,7 @@ Required argument '--exact' received no value""" ) exc.Message - |> shouldEqual """Unable to process argument --b=false as key --b and value false""" + |> shouldEqual """Parse error: The following positional arguments were not consumed: --b=false --c hi --help""" let exc = Assert.Throws (fun () -> @@ -703,4 +703,4 @@ Required argument '--exact' received no value""" // Again perhaps eccentric! // Again, we don't try to detect that the user has missed out the desired argument to `--a`. exc.Message - |> shouldEqual """Unable to process argument --c=hi as key --c and value hi""" + |> shouldEqual """Parse error: The following arguments were not consumed: --c=hi""" diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index e21bff4d..fbde8063 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -47,44 +47,6 @@ type internal Accumulation<'choice> = | ChoicePositional of attrContents : SynExpr option | 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 = //let log (s : string) = System.IO.File.AppendAllText ("/tmp/myriad.log", s + "\n") let private choice1Of2 = SynExpr.createIdent "Choice1Of2" @@ -974,108 +936,25 @@ module internal ShibaGenerator = match leaf.Positional with // TODO: account for includeFlagLike | Some includeFlagLike -> - // Positional args carried in from external argument. - // TODO: register whether they came before or after separator - match leaf.Acc with - | List acc -> - match acc with - | Accumulation.List _ -> - failwith "unexpected: positional args should not be a list of lists" - | Accumulation.Required -> - // TODO: we need to preserve the ordering on these with respect to - // the explicitly passed `--foo=` positionals - SynExpr.createIdent "positionals" - |> SynExpr.pipeThroughFunction ( - SynExpr.applyFunction - (SynExpr.createLongIdent [ "Seq" ; "map" ]) - (SynExpr.createLambda - "x" - (SynExpr.createMatch - (SynExpr.createIdent "x") - [ - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Choice1Of2" ] - (SynArgPats.createNamed [ "x" ])) - (SynExpr.createIdent "x") - SynMatchClause.create - (SynPat.identWithArgs - [ Ident.create "Choice2Of2" ] - (SynArgPats.createNamed [ "x" ])) - (SynExpr.createIdent "x") - ])) - ) - |> SynExpr.pipeThroughFunction ( - let body = - SynExpr.tupleNoParen - [ - SynExpr.pipeThroughFunction - leaf.ParseFn - (SynExpr.createIdent "str") - SynExpr.createIdent "argNum_" - ] - - SynExpr.applyFunction - (SynExpr.createLongIdent [ "Seq" ; "map" ]) - (SynExpr.Lambda ( - false, - false, - SynSimplePats.create - [ - SynSimplePat.createId (Ident.create "str") - SynSimplePat.createId (Ident.create "argNum_") - ], - body, - Some ( - [ - SynPat.tuple - [ SynPat.named "str" ; SynPat.named "argNum_" ] - ], - body - ), - range0, - { - ArrowRange = Some range0 - } - ) - |> SynExpr.paren) - ) - |> SynExpr.pipeThroughFunction ( - SynExpr.createLambda - "x" - (SynExpr.createLongIdent [ "Seq" ; "append" ] - |> SynExpr.applyTo ( - SynExpr.createLongIdent' - [ Ident.create "this" ; leaf.TargetConstructionField ] - ) - |> SynExpr.applyTo (SynExpr.createIdent "x")) - ) - |> SynExpr.pipeThroughFunction ( - SynExpr.applyFunction - (SynExpr.createLongIdent [ "Seq" ; "sortBy" ]) - (SynExpr.createIdent "snd") - ) - |> SynExpr.pipeThroughFunction ( - SynExpr.applyFunction - (SynExpr.createLongIdent [ "Seq" ; "map" ]) - (SynExpr.createIdent "fst") - ) - |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) - | Accumulation.Optional -> - failwith "unexpected: positional args should not be a list of options" - | Accumulation.Choice _ -> - failwith - "internal error: positional args, if Choicey, should be a ChoicePositional" - | Accumulation.ChoicePositional attrContents -> - [ - SynExpr.callMethodArg - "Add" - leaf.HumanReadableArgForm - (SynExpr.createIdent "positionalConsumers") + [ + SynExpr.callMethodArg + "Add" + leaf.HumanReadableArgForm + (SynExpr.createIdent "positionalConsumers") + // Positional args carried in from external argument. + // TODO: register whether they came before or after separator + match leaf.Acc with + | List acc -> + match acc with + | Accumulation.List _ -> + failwith "unexpected: positional args should not be a list of lists" + | Accumulation.Required -> + // TODO: we need to preserve the ordering on these with respect to + // the explicitly passed `--foo=` positionals SynExpr.createIdent "positionals" |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction - (SynExpr.createLongIdent [ "List" ; "map" ]) + (SynExpr.createLongIdent [ "Seq" ; "map" ]) (SynExpr.createLambda "x" (SynExpr.createMatch @@ -1084,40 +963,113 @@ module internal ShibaGenerator = SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Choice1Of2" ] - (SynArgPats.create - [ - SynPat.tuple - [ - SynPat.named "x" - SynPat.named "argPos" - ] - ])) - (SynExpr.applyFunction - leaf.ParseFn - (SynExpr.createIdent "x") - |> SynExpr.pipeThroughFunction choice1Of2) + (SynArgPats.createNamed [ "x" ])) + (SynExpr.createIdent "x") SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Choice2Of2" ] - (SynArgPats.create - [ - SynPat.tuple - [ - SynPat.named "x" - SynPat.named "argPos" - ] - ])) - (SynExpr.applyFunction - leaf.ParseFn - (SynExpr.createIdent "x") - |> SynExpr.pipeThroughFunction ( - SynExpr.createIdent "Choice2Of2" - )) + (SynArgPats.createNamed [ "x" ])) + (SynExpr.createIdent "x") ])) ) - ] - |> SynExpr.sequential - | _ -> failwith "unexpected: positional arguments should be a list" + |> SynExpr.pipeThroughFunction ( + let body = + SynExpr.tupleNoParen + [ + SynExpr.pipeThroughFunction + leaf.ParseFn + (SynExpr.createIdent "str") + SynExpr.createIdent "argNum_" + ] + + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.Lambda ( + false, + false, + SynSimplePats.create + [ + SynSimplePat.createId (Ident.create "str") + SynSimplePat.createId (Ident.create "argNum_") + ], + body, + Some ( + [ + SynPat.tuple + [ SynPat.named "str" ; SynPat.named "argNum_" ] + ], + body + ), + range0, + { + ArrowRange = Some range0 + } + ) + |> SynExpr.paren) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.createLongIdent [ "Seq" ; "append" ] + |> SynExpr.applyTo ( + SynExpr.createLongIdent' + [ Ident.create "this" ; leaf.TargetConstructionField ] + ) + |> SynExpr.applyTo (SynExpr.createIdent "x")) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "sortBy" ]) + (SynExpr.createIdent "snd") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createIdent "fst") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent [ "Seq" ; "toList" ] + ) + | Accumulation.Optional -> + failwith "unexpected: positional args should not be a list of options" + | Accumulation.Choice _ -> + failwith + "internal error: positional args, if Choicey, should be a ChoicePositional" + | Accumulation.ChoicePositional _attrContents -> + SynExpr.createIdent "positionals" + |> SynExpr.pipeThroughFunction ( + [ + SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction choice1Of2 + |> SynMatchClause.create ( + SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ SynPat.named "x" ; SynPat.named "argPos" ] + ]) + ) + + SynExpr.applyFunction leaf.ParseFn (SynExpr.createIdent "x") + |> SynExpr.pipeThroughFunction choice2Of2 + |> SynMatchClause.create ( + SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.create + [ + SynPat.tuple + [ SynPat.named "x" ; SynPat.named "argPos" ] + ]) + ) + ] + |> SynExpr.createMatch (SynExpr.createIdent "x") + |> SynExpr.createLambda "x" + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "List" ; "map" ]) + ) + | _ -> failwith "unexpected: positional arguments should be a list" + ] + |> SynExpr.sequential | None -> let parseFn = @@ -1749,13 +1701,19 @@ module internal ShibaGenerator = |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createIdent "args") - /// `failwithf "Unable to process argument ..."` + /// `positionals.Add arg ; go (argNum_ + 1) AwaitingKey args` let fail = - SynExpr.createIdent "failwithf" - |> SynExpr.applyTo (SynExpr.CreateConst "Unable to process argument %s as key %s and value %s") - |> SynExpr.applyTo (SynExpr.createIdent "arg") - |> SynExpr.applyTo (SynExpr.createIdent "key") - |> SynExpr.applyTo (SynExpr.createIdent "value") + [ + SynExpr.createIdent "positionals" + |> SynExpr.callMethodArg + "Add" + (SynExpr.tuple [ SynExpr.createIdent "arg" ; SynExpr.createIdent "argNum_" ] + |> SynExpr.applyFunction (SynExpr.createIdent "Choice1Of2") + |> SynExpr.paren) + + recurseKey + ] + |> SynExpr.sequential let processAsPositional = SynExpr.sequential @@ -2105,6 +2063,45 @@ module internal ShibaGenerator = ) |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") + // If we reach the end of the parse and there were positionals which were not consumed, + // we call this, which represents a parse failure. + // In scope are `positionals` (a ResizeArray of Choice<(string * int), (string * int)>) + // and `result`, an otherwise successful parsed output. + let printUnmatchedArgs = + SynExpr.createIdent "positionals" + // Map the Choice<_, _> to just the string argument + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createLongIdent [ "Seq" ; "map" ]) + (SynExpr.createLambda + "choiceValue" + (SynExpr.createMatch + (SynExpr.createIdent "choiceValue") + [ + // Case for args before '--' + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice1Of2" ] + (SynArgPats.create [ SynPat.tuple [ SynPat.named "arg" ; SynPat.anon ] ])) + (SynExpr.createIdent "arg") + // Case for args after '--' + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Choice2Of2" ] + (SynArgPats.create [ SynPat.tuple [ SynPat.named "arg" ; SynPat.anon ] ])) + (SynExpr.createIdent "arg") + ])) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst " ") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction + (SynExpr.createIdent "sprintf") + (SynExpr.CreateConst "Parse error: The following arguments were not consumed: %s") + ) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "failwith") + let parsePrime = [ SynExpr.applyFunction @@ -2129,7 +2126,7 @@ module internal ShibaGenerator = |> SynExpr.greaterThan (SynExpr.CreateConst 0)) (SynExpr.dotGet "IsNone" (SynExpr.createIdent "posConsumer"))) (SynExpr.createIdent "result") - (SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO"))) + printUnmatchedArgs) SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "e" ]) (raiseErrors (Ident.create "e")) From 2f266b052d58df2f97217e8d44e091245ae30b00 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 16:02:20 +0100 Subject: [PATCH 21/26] Fix another test --- ConsumePlugin/GeneratedArgs.fs | 123 ++++++++++-------- .../TestArgParser/TestArgParser.fs | 11 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 32 ++++- 3 files changed, 103 insertions(+), 63 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index ce7f2b7a..450457a7 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -161,7 +161,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -335,7 +336,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -513,7 +515,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -882,7 +885,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -1236,7 +1240,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -1457,7 +1462,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1571,7 +1577,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1689,10 +1696,11 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> + | Error None -> match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromRecord -> Error None + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -1812,7 +1820,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -1930,10 +1939,11 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> + | Error None -> match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromRecord -> Error None + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2061,10 +2071,11 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> + | Error None -> match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromRecord -> Error None + | Error errorFromRecord -> Error errorFromRecord + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2140,7 +2151,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -2237,7 +2249,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2345,7 +2358,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2481,7 +2495,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2593,7 +2608,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2772,7 +2788,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = @@ -2912,7 +2929,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3017,7 +3035,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3131,7 +3150,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3240,7 +3260,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3354,7 +3375,8 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueSelf_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromLeaf -> Error None + | Error None -> Error None + | Error (Some errorFromLeaf) -> Error (Some errorFromLeaf) /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3432,7 +3454,7 @@ module internal ArgParseHelpers_ConsumePlugin = = match this.ProcessKeyValueRecord_ argNum_ errors_ key value with | Ok () -> Ok () - | Error errorFromRecord -> Error None + | Error errorFromRecord -> Error errorFromRecord /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false @@ -3485,7 +3507,7 @@ module PassThruArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_PassThru.AwaitingValue arg) + go (argNum_ + 1) (ParseState_PassThru.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -3600,7 +3622,7 @@ module FlagsIntoPositionalArgs'ArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs'.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -3715,8 +3737,10 @@ module FlagsIntoPositionalArgsIntChoiceArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args - |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + go + (argNum_ + 1) + (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg) + args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -3840,8 +3864,7 @@ module FlagsIntoPositionalArgsIntArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args - |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -3956,8 +3979,7 @@ module FlagsIntoPositionalArgsChoiceArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args - |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4073,7 +4095,7 @@ module FlagsIntoPositionalArgsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) + go (argNum_ + 1) (ParseState_FlagsIntoPositionalArgs.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4182,7 +4204,7 @@ module ManyLongFormsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ManyLongForms.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ManyLongForms.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4297,7 +4319,7 @@ module ContainsFlagDefaultValueArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsFlagDefaultValue.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4408,7 +4430,7 @@ module ContainsFlagEnvVarArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ContainsFlagEnvVar.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsFlagEnvVar.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4517,7 +4539,7 @@ module WithFlagDuArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_WithFlagDu.AwaitingValue arg) + go (argNum_ + 1) (ParseState_WithFlagDu.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4628,7 +4650,7 @@ module ContainsBoolEnvVarArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ContainsBoolEnvVar.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ContainsBoolEnvVar.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4739,7 +4761,7 @@ module ChoicePositionalsArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ChoicePositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ChoicePositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4850,7 +4872,7 @@ module ParentRecordSelfPosArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ParentRecordSelfPos.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecordSelfPos.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -4961,7 +4983,7 @@ module ParentRecordChildPosArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ParentRecordChildPos.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecordChildPos.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5070,7 +5092,7 @@ module ParentRecordArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_ParentRecord.AwaitingValue arg) + go (argNum_ + 1) (ParseState_ParentRecord.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5179,7 +5201,7 @@ module DatesAndTimesArgParse = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_DatesAndTimes.AwaitingValue arg) + go (argNum_ + 1) (ParseState_DatesAndTimes.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5286,8 +5308,7 @@ module LoadsOfTypesNoPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args - |> go (argNum_ + 1) (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_LoadsOfTypesNoPositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5392,7 +5413,7 @@ module LoadsOfTypes = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_LoadsOfTypes.AwaitingValue arg) + go (argNum_ + 1) (ParseState_LoadsOfTypes.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5499,7 +5520,7 @@ module BasicWithIntPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_BasicWithIntPositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_BasicWithIntPositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5604,7 +5625,7 @@ module Basic = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_Basic.AwaitingValue arg) + go (argNum_ + 1) (ParseState_Basic.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] @@ -5711,7 +5732,7 @@ module BasicNoPositionals = let equals = arg.IndexOf (char 61) if equals < 0 then - args |> go (argNum_ + 1) (ParseState_BasicNoPositionals.AwaitingValue arg) + go (argNum_ + 1) (ParseState_BasicNoPositionals.AwaitingValue arg) args else let key = arg.[0 .. equals - 1] let value = arg.[equals + 1 ..] diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index e4643bb3..07fd2b1b 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -318,8 +318,7 @@ Required argument '--baz' received no value""" exc.Message |> shouldEqual """Errors during parse! -Input string was not in a correct format. (at arg --invariant-exact=23:59) -Required argument '--invariant-exact' received no value""" +Input string was not in a correct format. (at arg --invariant-exact=23:59)""" let exc = Assert.Throws (fun () -> @@ -337,8 +336,7 @@ Required argument '--invariant-exact' received no value""" exc.Message |> shouldEqual """Errors during parse! -Input string was not in a correct format. (at arg --exact=11:34) -Required argument '--exact' received no value""" +Input string was not in a correct format. (at arg --exact=11:34)""" count.Value |> shouldEqual 0 @@ -604,7 +602,10 @@ Required argument '--exact' received no value""" ) exc.Message - |> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo""" + |> shouldEqual + """Errors during parse! +Required argument '--do-something-else' received no value +Required argument '--turn-it-on' received no value""" [] let ``Long-form args help text`` () = diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index fbde8063..42159351 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1298,12 +1298,9 @@ module internal ShibaGenerator = |> Some let processKeyValue = - let afterErrorFromRecord = - SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None") - let afterErrorFromLeaf = match processKeyValueChildRecords with - | None -> afterErrorFromRecord + | None -> SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None") | Some _ -> [ SynMatchClause.create @@ -1311,7 +1308,7 @@ module internal ShibaGenerator = (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "errorFromRecord" ]) - afterErrorFromRecord + (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "errorFromRecord")) ] |> SynExpr.createMatch ( SynExpr.createLongIdent [ "this" ; "ProcessKeyValueRecord_" ] @@ -1330,8 +1327,29 @@ module internal ShibaGenerator = (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) (SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())) SynMatchClause.create - (SynPat.nameWithArgs "Error" [ SynPat.named "errorFromLeaf" ]) + (SynPat.nameWithArgs "Error" [ SynPat.named "None" ]) + // We didn't manage to parse this arg, but we didn't actually fail to do so; + // give our sub-parsers a try. afterErrorFromLeaf + SynMatchClause.create + (SynPat.nameWithArgs + "Error" + [ + SynPat.paren ( + SynPat.identWithArgs + [ Ident.create "Some" ] + (SynArgPats.createNamed [ "errorFromLeaf" ]) + ) + ]) + // We tried and explicitly failed to consume the argument ourselves, so just hand the error + // back out without even trying our sub-parsers. + (SynExpr.applyFunction + (SynExpr.createIdent "Error") + (SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createIdent "Some") + (SynExpr.createIdent "errorFromLeaf") + ))) ] |> SynExpr.createMatch ( SynExpr.createLongIdent [ "this" ; "ProcessKeyValueSelf_" ] @@ -1804,7 +1822,7 @@ module internal ShibaGenerator = (SynPat.nameWithArgs "Error" [ SynPat.named "x" ]) notMatched ])) - (SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue))) + (SynExpr.createIdent "args" |> SynExpr.applyFunction recurseValue))) ( //SynExpr.createIdent "helpText" //|> SynExpr.applyTo (SynExpr.CreateConst ()) SynExpr.CreateConst "TODO" From 01714aeba0747a55df40b9cbd2c5b0e61fcf4783 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 18:31:25 +0100 Subject: [PATCH 22/26] Fix all but the help text --- ConsumePlugin/GeneratedArgs.fs | 654 +++++++++++++----- .../TestArgParser/TestArgParser.fs | 15 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 124 +++- 3 files changed, 591 insertions(+), 202 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index 450457a7..c2fb59c9 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -34,6 +34,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Foo with @@ -58,8 +59,19 @@ module internal ArgParseHelpers_ConsumePlugin = let arg3 : int list = this.Rest |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Foo = arg0 @@ -70,12 +82,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : BasicNoPositionals_InProgress = { @@ -196,6 +208,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Foo with @@ -224,7 +237,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) @@ -233,8 +251,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Foo = arg0 @@ -245,12 +274,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : Basic_InProgress = { @@ -371,6 +400,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Foo with @@ -399,7 +429,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) @@ -408,8 +443,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Foo = arg0 @@ -420,12 +466,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : BasicWithIntPositionals_InProgress = { @@ -557,6 +603,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Foo with @@ -603,7 +650,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) @@ -627,8 +679,19 @@ module internal ArgParseHelpers_ConsumePlugin = | Some result -> Choice1Of2 result | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Foo = arg0 @@ -646,12 +709,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : LoadsOfTypes_InProgress = { @@ -938,6 +1001,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Foo with @@ -993,8 +1057,19 @@ module internal ArgParseHelpers_ConsumePlugin = | Some result -> Choice1Of2 result | None -> Choice2Of2 ("CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable |> (fun x -> x)) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Foo = arg0 @@ -1011,12 +1086,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : LoadsOfTypesNoPositionals_InProgress = { @@ -1287,6 +1362,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : TimeSpan = match this.Plain with @@ -1317,8 +1393,19 @@ module internal ArgParseHelpers_ConsumePlugin = Unchecked.defaultof<_ > - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Plain = arg0 @@ -1329,12 +1416,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : DatesAndTimes_InProgress = { @@ -1483,6 +1570,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Thing1 with @@ -1498,8 +1586,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.Add (sprintf "Required argument '--%s' received no value" "thing2") Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Thing1 = arg0 @@ -1508,12 +1607,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ChildRecord_InProgress = { @@ -1598,6 +1697,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : ChildRecord = match this.Child.Assemble_ getEnvironmentVariable positionals with @@ -1618,8 +1718,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.Add (sprintf "Required argument '--%s' received no value" "and-another") Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Child = arg0 @@ -1628,12 +1739,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ParentRecord_InProgress = { @@ -1732,6 +1843,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : int = match this.Thing1 with @@ -1746,7 +1858,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Uri x), argNum_) @@ -1755,8 +1872,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Thing1 = arg0 @@ -1765,12 +1893,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ChildRecordWithPositional_InProgress = { @@ -1841,6 +1969,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : ChildRecordWithPositional = match this.Child.Assemble_ getEnvironmentVariable positionals with @@ -1861,8 +1990,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.Add (sprintf "Required argument '--%s' received no value" "and-another") Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Child = arg0 @@ -1871,12 +2011,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ParentRecordChildPos_InProgress = { @@ -1975,6 +2115,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : ChildRecord = match this.Child.Assemble_ getEnvironmentVariable positionals with @@ -1994,7 +2135,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Boolean.Parse x), argNum_) @@ -2003,8 +2149,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Child = arg0 @@ -2013,12 +2170,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ParentRecordSelfPos_InProgress = { @@ -2094,6 +2251,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : Choice list = positionalConsumers.Add (sprintf "--%s" "args") @@ -2105,8 +2263,19 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 ) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { Args = arg0 @@ -2114,12 +2283,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ChoicePositionals_InProgress = { @@ -2171,6 +2340,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : Choice = match this.BoolVar with @@ -2189,8 +2359,19 @@ module internal ArgParseHelpers_ConsumePlugin = ) ) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { BoolVar = arg0 @@ -2198,12 +2379,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ContainsBoolEnvVar_InProgress = { @@ -2281,6 +2462,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : DryRunMode = match this.DryRun with @@ -2289,8 +2471,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.Add (sprintf "Required argument '--%s' received no value" "dry-run") Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { DryRun = arg0 @@ -2298,12 +2491,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : WithFlagDu_InProgress = { @@ -2396,6 +2589,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : Choice = match this.DryRun with @@ -2426,8 +2620,19 @@ module internal ArgParseHelpers_ConsumePlugin = ) ) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { DryRun = arg0 @@ -2435,12 +2640,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ContainsFlagEnvVar_InProgress = { @@ -2533,14 +2738,26 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : Choice = match this.DryRun with | Some result -> Choice1Of2 result | None -> Choice2Of2 (ContainsFlagDefaultValue.DefaultDryRun ()) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { DryRun = arg0 @@ -2548,12 +2765,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ContainsFlagDefaultValue_InProgress = { @@ -2647,6 +2864,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.DoTheThing with @@ -2663,8 +2881,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.Add (sprintf "Required argument '--%s' received no value" "turn-it-on") Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { DoTheThing = arg0 @@ -2673,12 +2902,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : ManyLongForms_InProgress = { @@ -2839,6 +3068,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.A with @@ -2853,7 +3083,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (true) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) @@ -2862,8 +3097,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -2872,12 +3118,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : FlagsIntoPositionalArgs_InProgress = { @@ -2950,6 +3196,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.A with @@ -2968,8 +3215,19 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice2Of2 (x, argPos) -> (fun x -> x) x |> Choice2Of2 ) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -2978,12 +3236,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : FlagsIntoPositionalArgsChoice_InProgress = { @@ -3056,6 +3314,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.A with @@ -3070,7 +3329,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (true) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> System.Int32.Parse x), argNum_) @@ -3079,8 +3343,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -3089,12 +3364,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : FlagsIntoPositionalArgsInt_InProgress = { @@ -3171,6 +3446,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.A with @@ -3189,8 +3465,19 @@ module internal ArgParseHelpers_ConsumePlugin = | Choice2Of2 (x, argPos) -> (fun x -> System.Int32.Parse x) x |> Choice2Of2 ) - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -3199,12 +3486,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : FlagsIntoPositionalArgsIntChoice_InProgress = { @@ -3281,6 +3568,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : string = match this.A with @@ -3295,7 +3583,12 @@ module internal ArgParseHelpers_ConsumePlugin = positionals |> Seq.map (fun x -> match x with - | Choice1Of2 x -> x + | Choice1Of2 x -> + if not (false) && (fst x).StartsWith ("--", System.StringComparison.Ordinal) then + outOfPlacePositionals.Add (fst x) + x + else + x | Choice2Of2 x -> x ) |> Seq.map (fun (str, argNum_) -> str |> (fun x -> x), argNum_) @@ -3304,8 +3597,19 @@ module internal ArgParseHelpers_ConsumePlugin = |> Seq.map fst |> Seq.toList - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -3314,12 +3618,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : FlagsIntoPositionalArgs'_InProgress = { @@ -3395,6 +3699,7 @@ module internal ArgParseHelpers_ConsumePlugin = = let errors = ResizeArray () let positionalConsumers = ResizeArray () + let outOfPlacePositionals : ResizeArray = ResizeArray () let arg0 : ParentRecordChildPos = match this.A.Assemble_ getEnvironmentVariable positionals with @@ -3408,8 +3713,19 @@ module internal ArgParseHelpers_ConsumePlugin = errors.AddRange err Unchecked.defaultof<_> - if errors.Count = 0 then - if positionalConsumers.Count <= 1 then + if positionalConsumers.Count <= 1 then + if outOfPlacePositionals.Count > 0 then + outOfPlacePositionals + |> String.concat " " + |> (fun x -> + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " + + x + ) + |> errors.Add + else + () + + if errors.Count = 0 then Ok ( { A = arg0 @@ -3417,12 +3733,12 @@ module internal ArgParseHelpers_ConsumePlugin = Seq.tryExactlyOne positionalConsumers ) else - ("Multiple parsers consumed positional args: " - + String.concat ", " positionalConsumers) - |> List.singleton - |> Error + errors |> Seq.toList |> Error else - errors |> Seq.toList |> Error + ("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + + String.concat ", " positionalConsumers) + |> List.singleton + |> Error static member _Empty () : PassThru_InProgress = { diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index 07fd2b1b..b63c060d 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -79,11 +79,8 @@ module TestArgParser = exc.Message |> shouldEqual - """Parse error: The following arguments were not consumed: --non-existent. to process supplied arg --non-existent. Help text follows. ---foo int32 : This is a foo! ---bar string ---baz bool ---rest string (positional args) (can be repeated) : Here's where the rest of the args go""" + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --non-existent""" [] let ``Can supply positional args with key`` () = @@ -693,7 +690,9 @@ Required argument '--turn-it-on' received no value""" ) exc.Message - |> shouldEqual """Parse error: The following positional arguments were not consumed: --b=false --c hi --help""" + |> shouldEqual + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --b=false --c""" let exc = Assert.Throws (fun () -> @@ -704,4 +703,6 @@ Required argument '--turn-it-on' received no value""" // Again perhaps eccentric! // Again, we don't try to detect that the user has missed out the desired argument to `--a`. exc.Message - |> shouldEqual """Parse error: The following arguments were not consumed: --c=hi""" + |> shouldEqual + """Errors during parse! +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --c=hi""" diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 42159351..f6ea2195 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -84,6 +84,17 @@ module internal ShibaGenerator = result.ToString().TrimStart '-' + /// Expects `e` to be a string; calls `e.StartsWith("--", StringComparison.Ordinal)`. + let startsWithDashes (e : SynExpr) : SynExpr = + e + |> SynExpr.callMethodArg + "StartsWith" + (SynExpr.tuple + [ + SynExpr.CreateConst "--" + SynExpr.createLongIdent [ "System" ; "StringComparison" ; "Ordinal" ] + ]) + type LeafData<'choice> = { /// Call this function to turn the input into the `TypeAfterParse`. @@ -936,21 +947,33 @@ module internal ShibaGenerator = match leaf.Positional with // TODO: account for includeFlagLike | Some includeFlagLike -> - [ - SynExpr.callMethodArg - "Add" - leaf.HumanReadableArgForm - (SynExpr.createIdent "positionalConsumers") - // Positional args carried in from external argument. - // TODO: register whether they came before or after separator + let constructPositionalsList = match leaf.Acc with | List acc -> match acc with | Accumulation.List _ -> failwith "unexpected: positional args should not be a list of lists" | Accumulation.Required -> - // TODO: we need to preserve the ordering on these with respect to - // the explicitly passed `--foo=` positionals + // The condition that determines whether this looks like a flag that's mistakenly + // a conditional, which we should reject + let rejectFlagInPositional = + let includeFlagLike = + match includeFlagLike with + | None -> SynExpr.CreateConst false + | Some i -> i + + SynExpr.booleanAnd + (SynExpr.applyFunction + (SynExpr.createIdent "not") + (SynExpr.paren includeFlagLike)) + (startsWithDashes ( + SynExpr.paren ( + SynExpr.applyFunction + (SynExpr.createIdent "fst") + (SynExpr.createIdent "x") + ) + )) + SynExpr.createIdent "positionals" |> SynExpr.pipeThroughFunction ( SynExpr.applyFunction @@ -964,7 +987,21 @@ module internal ShibaGenerator = (SynPat.identWithArgs [ Ident.create "Choice1Of2" ] (SynArgPats.createNamed [ "x" ])) - (SynExpr.createIdent "x") + (SynExpr.ifThenElse + rejectFlagInPositional + (SynExpr.createIdent "x") + (SynExpr.sequential + [ + SynExpr.callMethodArg + "Add" + (SynExpr.applyFunction + (SynExpr.createIdent "fst") + (SynExpr.createIdent "x") + |> SynExpr.paren) + (SynExpr.createIdent + "outOfPlacePositionals") + (SynExpr.createIdent "x") + ])) SynMatchClause.create (SynPat.identWithArgs [ Ident.create "Choice2Of2" ] @@ -1068,6 +1105,15 @@ module internal ShibaGenerator = |> SynExpr.applyFunction (SynExpr.createLongIdent [ "List" ; "map" ]) ) | _ -> failwith "unexpected: positional arguments should be a list" + + [ + SynExpr.callMethodArg + "Add" + leaf.HumanReadableArgForm + (SynExpr.createIdent "positionalConsumers") + // If any of the Choice1Of2 positional args look like flags, + // and `not includeFlagLike`, then store a parse error. + [ constructPositionalsList ] |> SynExpr.sequential ] |> SynExpr.sequential | None -> @@ -1179,7 +1225,36 @@ module internal ShibaGenerator = |> List.singleton ) - instantiation + [ + SynExpr.createIdent "outOfPlacePositionals" + |> SynExpr.pipeThroughFunction ( + SynExpr.createLongIdent [ "String" ; "concat" ] + |> SynExpr.applyTo (SynExpr.CreateConst " ") + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "x" + (SynExpr.plus + // TODO: if we have a positional consumer, point this out, but otherwise don't + // TODO: print the help text here + (SynExpr.CreateConst + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. ") + (SynExpr.createIdent "x")) + ) + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "errors" ; "Add" ]) + |> SynExpr.ifThenElse + (SynExpr.dotGet "Count" (SynExpr.createIdent "outOfPlacePositionals") + |> SynExpr.greaterThan (SynExpr.CreateConst 0)) + (SynExpr.CreateConst ()) + + instantiation + |> SynExpr.ifThenElse + (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) + (SynExpr.createIdent "errors" + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) + |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) + ] + |> SynExpr.sequential |> SynExpr.ifThenElse (SynExpr.lessThanOrEqual (SynExpr.CreateConst 1) @@ -1188,15 +1263,13 @@ module internal ShibaGenerator = |> SynExpr.applyFunction ( SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst ", ") ) - |> SynExpr.plus (SynExpr.CreateConst "Multiple parsers consumed positional args: ") + |> SynExpr.plus ( + SynExpr.CreateConst + "Multiple parsers consumed positional args; this is an error in the application, not an error by the user: " + ) |> SynExpr.paren |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "List" ; "singleton" ]) |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) - |> SynExpr.ifThenElse - (SynExpr.equals (SynExpr.dotGet "Count" (SynExpr.createIdent "errors")) (SynExpr.CreateConst 0)) - (SynExpr.createIdent "errors" - |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) - |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error")) |> SynExpr.createLet assignVariables |> SynExpr.createLet [ @@ -1212,6 +1285,13 @@ module internal ShibaGenerator = (SynExpr.applyFunction (SynExpr.typeApp [ SynType.string ] (SynExpr.createIdent "ResizeArray")) (SynExpr.CreateConst ())) + // TODO: we can optimise this away if we know already we're accepting all positionals, + // although we can only guess this with heuristics in the generator + SynBinding.basic + [ Ident.create "outOfPlacePositionals" ] + [] + (SynExpr.applyFunction (SynExpr.createIdent "ResizeArray") (SynExpr.CreateConst ())) + |> SynBinding.withReturnAnnotation (SynType.app "ResizeArray" [ SynType.string ]) ] |> SynBinding.basic [ Ident.create "this" ; Ident.create "Assemble_" ] @@ -1765,15 +1845,7 @@ module internal ShibaGenerator = handleFailure - let argStartsWithDashes = - SynExpr.createIdent "arg" - |> SynExpr.callMethodArg - "StartsWith" - (SynExpr.tuple - [ - SynExpr.CreateConst "--" - SynExpr.createLongIdent [ "System" ; "StringComparison" ; "Ordinal" ] - ]) + let argStartsWithDashes = startsWithDashes (SynExpr.createIdent "arg") let processKey = SynExpr.ifThenElse From 75ce8c1f64429c6b6596e95dd08bb7de2b2e454b Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 18:45:57 +0100 Subject: [PATCH 23/26] Fix test --- ConsumePlugin/GeneratedArgs.fs | 207 ++++++++++++++---- .../TestArgParser/TestArgParser.fs | 4 +- WoofWare.Myriad.Plugins/ShibaGenerator.fs | 22 +- 3 files changed, 179 insertions(+), 54 deletions(-) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index c2fb59c9..abb1f6f4 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -64,8 +64,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -256,8 +261,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -448,8 +458,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -684,8 +699,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1062,8 +1082,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1398,8 +1423,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1591,8 +1621,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1723,8 +1758,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1877,8 +1917,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -1995,8 +2040,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2154,8 +2204,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2268,8 +2323,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2364,8 +2424,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2476,8 +2541,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2625,8 +2695,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2750,8 +2825,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -2886,8 +2966,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3102,8 +3187,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3220,8 +3310,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3348,8 +3443,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3470,8 +3570,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3602,8 +3707,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else @@ -3718,8 +3828,13 @@ module internal ArgParseHelpers_ConsumePlugin = outOfPlacePositionals |> String.concat " " |> (fun x -> - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. " - + x + if 0 = outOfPlacePositionals.Count then + "Unmatched args which look like they are meant to be flags. " + x + else + sprintf + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + positionalConsumers.[0] + x ) |> errors.Add else diff --git a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs index b63c060d..e6a53755 100644 --- a/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs +++ b/WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs @@ -80,7 +80,7 @@ module TestArgParser = exc.Message |> shouldEqual """Errors during parse! -Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --non-existent""" +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--rest=` syntax, or place them after a trailing `--`. --non-existent""" [] let ``Can supply positional args with key`` () = @@ -692,7 +692,7 @@ Required argument '--turn-it-on' received no value""" exc.Message |> shouldEqual """Errors during parse! -Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --b=false --c""" +Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--dont-grab-everything=` syntax, or place them after a trailing `--`. --b=false --c""" let exc = Assert.Throws (fun () -> diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index f6ea2195..971ef9fb 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1234,12 +1234,22 @@ module internal ShibaGenerator = |> SynExpr.pipeThroughFunction ( SynExpr.createLambda "x" - (SynExpr.plus - // TODO: if we have a positional consumer, point this out, but otherwise don't - // TODO: print the help text here - (SynExpr.CreateConst - "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. ") - (SynExpr.createIdent "x")) + (SynExpr.ifThenElse + (SynExpr.equals + (SynExpr.CreateConst 0) + (SynExpr.dotGet "Count" (SynExpr.createIdent "outOfPlacePositionals"))) + ((SynExpr.createIdent "sprintf") + |> SynExpr.applyTo ( + SynExpr.CreateConst + "Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s" + ) + |> SynExpr.applyTo ( + SynExpr.index (SynExpr.CreateConst 0) (SynExpr.createIdent "positionalConsumers") + ) + |> SynExpr.applyTo (SynExpr.createIdent "x")) + (SynExpr.plus + (SynExpr.CreateConst "Unmatched args which look like they are meant to be flags. ") + (SynExpr.createIdent "x"))) ) |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "errors" ; "Add" ]) |> SynExpr.ifThenElse From 3ed8d4db0003ae3953819d6ef4951dbadf76144d Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 21:38:44 +0100 Subject: [PATCH 24/26] Add help text placeholder --- ConsumePlugin/GeneratedArgs.fs | 58 +++++++++++++++++++++++ WoofWare.Myriad.Plugins/ShibaGenerator.fs | 17 +++++++ 2 files changed, 75 insertions(+) diff --git a/ConsumePlugin/GeneratedArgs.fs b/ConsumePlugin/GeneratedArgs.fs index abb1f6f4..af936cef 100644 --- a/ConsumePlugin/GeneratedArgs.fs +++ b/ConsumePlugin/GeneratedArgs.fs @@ -196,6 +196,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed Basic. type internal Basic_InProgress = { @@ -393,6 +396,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed BasicWithIntPositionals. type internal BasicWithIntPositionals_InProgress = { @@ -594,6 +600,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed LoadsOfTypes. type internal LoadsOfTypes_InProgress = { @@ -998,6 +1007,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed LoadsOfTypesNoPositionals. type internal LoadsOfTypesNoPositionals_InProgress = { @@ -1370,6 +1382,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed DatesAndTimes. type internal DatesAndTimes_InProgress = { @@ -1584,6 +1599,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed ChildRecord. type internal ChildRecord_InProgress = @@ -1716,6 +1733,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed ParentRecord. type internal ParentRecord_InProgress = @@ -1868,6 +1887,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed ChildRecordWithPositional. type internal ChildRecordWithPositional_InProgress = { @@ -1998,6 +2020,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed ParentRecordChildPos. type internal ParentRecordChildPos_InProgress = @@ -2150,6 +2174,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed ParentRecordSelfPos. type internal ParentRecordSelfPos_InProgress = { @@ -2291,6 +2318,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed ChoicePositionals. type internal ChoicePositionals_InProgress = @@ -2385,6 +2414,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed ContainsBoolEnvVar. type internal ContainsBoolEnvVar_InProgress = @@ -2513,6 +2544,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed WithFlagDu. type internal WithFlagDu_InProgress = { @@ -2645,6 +2679,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed ContainsFlagEnvVar. type internal ContainsFlagEnvVar_InProgress = { @@ -2799,6 +2836,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed ContainsFlagDefaultValue. type internal ContainsFlagDefaultValue_InProgress = { @@ -2929,6 +2969,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed ManyLongForms. type internal ManyLongForms_InProgress = { @@ -3138,6 +3181,9 @@ module internal ArgParseHelpers_ConsumePlugin = else false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" + /// A partially-parsed FlagsIntoPositionalArgs. type internal FlagsIntoPositionalArgs_InProgress = { @@ -3270,6 +3316,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed FlagsIntoPositionalArgsChoice. type internal FlagsIntoPositionalArgsChoice_InProgress = @@ -3393,6 +3441,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed FlagsIntoPositionalArgsInt. type internal FlagsIntoPositionalArgsInt_InProgress = @@ -3530,6 +3580,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed FlagsIntoPositionalArgsIntChoice. type internal FlagsIntoPositionalArgsIntChoice_InProgress = @@ -3657,6 +3709,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed FlagsIntoPositionalArgs'. type internal FlagsIntoPositionalArgs'_InProgress = @@ -3794,6 +3848,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" /// A partially-parsed PassThru. type internal PassThru_InProgress = @@ -3889,6 +3945,8 @@ module internal ArgParseHelpers_ConsumePlugin = /// Returns false if we didn't set a value. member this.SetFlagValue_ (errors_ : ResizeArray) (key : string) : bool = false + /// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces. + static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO" namespace ConsumePlugin open ArgParserHelpers diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 971ef9fb..e3f6d102 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -1339,6 +1339,22 @@ module internal ShibaGenerator = ) |> SynMemberDefn.memberImplementation + let helpText = + SynExpr.createIdent "failwith" + |> SynExpr.applyTo (SynExpr.CreateConst "TODO") + |> SynBinding.basic + [ Ident.create "HelpText_" ] + [ + SynPat.named "prefix" |> SynPat.annotateType (SynType.option SynType.string) + SynPat.named "indent" |> SynPat.annotateType SynType.int + ] + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces." + ) + |> SynBinding.withReturnAnnotation SynType.string + |> SynMemberDefn.staticMember + let emptyConstructor = [ for KeyValue (nodeName, leaf) in record.LeafNodes do @@ -1501,6 +1517,7 @@ module internal ShibaGenerator = processKeyValueChildRecords Some processKeyValue Some setFlagValue + Some helpText ] |> List.choose id |> Some From 7b2c3d21684722ee76978dd0340229d046acef66 Mon Sep 17 00:00:00 2001 From: Smaug123 <3138005+Smaug123@users.noreply.github.com> Date: Thu, 17 Apr 2025 21:56:18 +0100 Subject: [PATCH 25/26] Start on the union generator --- ConsumePlugin/ArgsWithUnions.fs | 35 ++++++ ConsumePlugin/ConsumePlugin.fsproj | 4 + WoofWare.Myriad.Plugins/List.fs | 10 ++ WoofWare.Myriad.Plugins/ShibaGenerator.fs | 144 ++++++++++++++-------- 4 files changed, 141 insertions(+), 52 deletions(-) create mode 100644 ConsumePlugin/ArgsWithUnions.fs diff --git a/ConsumePlugin/ArgsWithUnions.fs b/ConsumePlugin/ArgsWithUnions.fs new file mode 100644 index 00000000..53974428 --- /dev/null +++ b/ConsumePlugin/ArgsWithUnions.fs @@ -0,0 +1,35 @@ +namespace ConsumePlugin.ArgsWithUnions + +open System +open System.IO +open WoofWare.Myriad.Plugins + +type BasicNoPositionals = + { + Foo : int + Bar : string + Baz : bool + Rest : int list + } + +type UsernamePasswordAuth = + { + Username : string + Password : string + } + +type TokenAuth = + { + Token : string + } + +type AuthOptions = + | UsernamePassword of UsernamePasswordAuth + | Token of TokenAuth + +[] +type DoTheThing = + { + Basics : BasicNoPositionals + Auth : AuthOptions + } diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj index 41927305..06b55b60 100644 --- a/ConsumePlugin/ConsumePlugin.fsproj +++ b/ConsumePlugin/ConsumePlugin.fsproj @@ -72,6 +72,10 @@ Args.fs + + + ArgsWithUnions.fs + + + diff --git a/WoofWare.Myriad.Plugins/ShibaGenerator.fs b/WoofWare.Myriad.Plugins/ShibaGenerator.fs index 816086bd..fb636d98 100644 --- a/WoofWare.Myriad.Plugins/ShibaGenerator.fs +++ b/WoofWare.Myriad.Plugins/ShibaGenerator.fs @@ -52,6 +52,9 @@ module internal ShibaGenerator = let private choice1Of2 = SynExpr.createIdent "Choice1Of2" let private choice2Of2 = SynExpr.createIdent "Choice2Of2" + let private defaultOf = + SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) + type RecognisedType = | Union of UnionType | Record of RecordType @@ -477,6 +480,7 @@ module internal ShibaGenerator = with | Error e -> Error e | Ok parseFn -> + match parseFn with | ParseFunctionSpec.Leaf data -> { data with @@ -490,28 +494,23 @@ module internal ShibaGenerator = | ty -> match identifyAsFlag flagDus ty with | None -> - let recognisedRecords = - userDefinedRecordTypesWithParser - |> String.concat ", " - let recognisedUnions = - userDefinedUnionTypesWithParser - |> String.concat ", " + let recognisedRecords = userDefinedRecordTypesWithParser |> String.concat ", " + let recognisedUnions = userDefinedUnionTypesWithParser |> String.concat ", " + let errorMessage = $"we did not recognise the type %s{SynType.toHumanReadableString ty} as something we could build a parser for; we know about these record types:\n%s{recognisedRecords}\nand these unions:\n%s{recognisedUnions}" + match ty with | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> let typeName = List.last id if Seq.contains typeName.idText userDefinedRecordTypesWithParser then - ParseFunctionSpec.UserDefined (true, typeName) - |> Ok + ParseFunctionSpec.UserDefined (true, typeName) |> Ok elif Seq.contains (List.last id).idText userDefinedUnionTypesWithParser then - ParseFunctionSpec.UserDefined (false, typeName) - |> Ok + ParseFunctionSpec.UserDefined (false, typeName) |> Ok else Error errorMessage - | _ -> - Error errorMessage + | _ -> Error errorMessage | Some flagDu -> // Parse as a bool, and then do the `if-then` dance. let parser = @@ -550,6 +549,7 @@ module internal ShibaGenerator = and internal ParsedUnionStructure<'choice> = { + NameOfInProgressType : Ident Original : UnionType Cases : Map> } @@ -815,6 +815,23 @@ module internal ShibaGenerator = ) |> SynBinding.makeInstanceMember + /// `static member HelpText_ (prefix : string option) (indent : int) = ...` + let private helpTextBinding : SynMemberDefn = + SynExpr.createIdent "failwith" + |> SynExpr.applyTo (SynExpr.CreateConst "TODO") + |> SynBinding.basic + [ Ident.create "HelpText_" ] + [ + SynPat.named "prefix" |> SynPat.annotateType (SynType.option SynType.string) + SynPat.named "indent" |> SynPat.annotateType SynType.int + ] + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces." + ) + |> SynBinding.withReturnAnnotation SynType.string + |> SynMemberDefn.staticMember + /// Build the "in-progress record" which is basically "the input record, but with all fields mutable and optional". let private inProgressRecordType (record : ParsedRecordStructure) : RecordType = let leafFields = @@ -850,7 +867,14 @@ module internal ShibaGenerator = let unionFields = record.Unions |> Map.toSeq - |> Seq.map (fun (ident, data) -> failwith "TODO") + |> Seq.map (fun (ident, data) -> + { + Attrs = [] + Ident = Ident.create ident |> Some + Type = SynType.createLongIdent [ data.NameOfInProgressType ] + } + |> SynField.make + ) |> Seq.toList let recordFields = @@ -904,9 +928,6 @@ module internal ShibaGenerator = |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createIdent "Ok") - let defaultOf = - SynExpr.typeApp [ SynType.anon ] (SynExpr.createLongIdent [ "Unchecked" ; "defaultof" ]) - let assignVariables = record.Original.Fields |> List.mapi (fun i f -> (i, f)) @@ -919,14 +940,13 @@ module internal ShibaGenerator = let valueForThisVar = match record.Records |> Map.tryFind ident.idText with - | Some subRecord -> + | Some _subRecord -> // This was a record; defer to its parser. let subAssembleCall = SynExpr.dotGet ident.idText (SynExpr.createIdent "this") |> SynExpr.callMethodArg "Assemble_" (SynExpr.createIdent "getEnvironmentVariable") |> SynExpr.applyTo (SynExpr.createIdent "positionals") - // TODO: need to know if it has positionals [ SynMatchClause.create (SynPat.identWithArgs @@ -969,15 +989,57 @@ module internal ShibaGenerator = | None -> match record.Unions |> Map.tryFind ident.idText with - | Some union -> + | Some _union -> // This was a union; defer to its parser. - failwith "TODO" + let subAssembleCall = + SynExpr.dotGet ident.idText (SynExpr.createIdent "this") + |> SynExpr.callMethodArg "Assemble_" (SynExpr.createIdent "getEnvironmentVariable") + |> SynExpr.applyTo (SynExpr.createIdent "positionals") + + [ + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Ok" ] + (SynArgPats.create + [ SynPat.named "result" ; SynPat.named "consumedPositional" ])) + (SynExpr.sequential + [ + SynExpr.createMatch + (SynExpr.createIdent "consumedPositional") + [ + SynMatchClause.create + (SynPat.named "None") + (SynExpr.CreateConst ()) + SynMatchClause.create + (SynPat.nameWithArgs + "Some" + [ SynPat.named "positionalConsumer" ]) + (SynExpr.callMethodArg + "Add" + (SynExpr.createIdent "positionalConsumer") + (SynExpr.createIdent "positionalConsumers")) + ] + SynExpr.createIdent "result" + ]) + SynMatchClause.create + (SynPat.identWithArgs + [ Ident.create "Error" ] + (SynArgPats.create [ SynPat.named "err" ])) + (SynExpr.sequential + [ + SynExpr.callMethodArg + "AddRange" + (SynExpr.createIdent "err") + (SynExpr.createIdent "errors") + defaultOf + ]) + ] + |> SynExpr.createMatch subAssembleCall | None -> match record.LeafNodes |> Map.tryFind ident.idText with | Some leaf -> match leaf.Positional with - // TODO: account for includeFlagLike | Some includeFlagLike -> let constructPositionalsList = match leaf.Acc with @@ -1371,22 +1433,6 @@ module internal ShibaGenerator = ) |> SynMemberDefn.memberImplementation - let helpText = - SynExpr.createIdent "failwith" - |> SynExpr.applyTo (SynExpr.CreateConst "TODO") - |> SynBinding.basic - [ Ident.create "HelpText_" ] - [ - SynPat.named "prefix" |> SynPat.annotateType (SynType.option SynType.string) - SynPat.named "indent" |> SynPat.annotateType SynType.int - ] - |> SynBinding.withXmlDoc ( - PreXmlDoc.create - "Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces." - ) - |> SynBinding.withReturnAnnotation SynType.string - |> SynMemberDefn.staticMember - let emptyConstructor = [ for KeyValue (nodeName, leaf) in record.LeafNodes do @@ -1405,7 +1451,9 @@ module internal ShibaGenerator = SynLongIdent.create [ Ident.create nodeName ], SynExpr.callMethod "_Empty" (SynExpr.createIdent' subRecord.NameOfInProgressType) for KeyValue (nodeName, subUnion) in record.Unions do - yield SynLongIdent.create [ Ident.create nodeName ], failwith "TODO" + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subUnion.NameOfInProgressType) ] |> SynExpr.createRecord None |> SynBinding.basic [ Ident.create "_Empty" ] [ SynPat.unit ] @@ -1549,7 +1597,7 @@ module internal ShibaGenerator = processKeyValueChildRecords Some processKeyValue Some setFlagValue - Some helpText + Some helpTextBinding ] |> List.choose id |> Some @@ -1564,6 +1612,90 @@ module internal ShibaGenerator = Attributes = [] } + /// Build the "in-progress union" which is basically "a record with one parser for each union case". + let private inProgressUnionType (union : ParsedUnionStructure) : RecordType = + let fields = + union.Cases + |> Map.toSeq + |> Seq.map (fun (caseName, structure) -> + { + Attrs = [] + Ident = Ident.create caseName |> Some + Type = SynType.createLongIdent [ structure.NameOfInProgressType ] + } + |> SynField.make + ) + |> Seq.toList + + let assembleMethod = + // Go over each case attempting to consume it. + // If exactly one case manages to do it, we win. + SynExpr.applyFunction (SynExpr.createIdent "failwith") (SynExpr.CreateConst "TODO") + |> SynBinding.basic + [ Ident.create "this" ; Ident.create "Assemble_" ] + [ + SynPat.annotateType + (SynType.funFromDomain SynType.string SynType.string) + (SynPat.named "getEnvironmentVariable") + SynPat.annotateType + (SynType.list ( + SynType.app + "Choice" + [ + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + SynType.tupleNoParen [ SynType.string ; SynType.int ] |> Option.get + ] + )) + (SynPat.named "positionals") + ] + |> SynBinding.withReturnAnnotation ( + SynType.app + "Result" + [ + SynType.tupleNoParen + [ + SynType.createLongIdent [ union.Original.Name ] + SynType.option SynType.string + ] + |> Option.get + SynType.list SynType.string + ] + ) + |> SynBinding.withXmlDoc ( + PreXmlDoc.create + "Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args." + ) + |> SynMemberDefn.memberImplementation + + let emptyConstructor = + [ + for KeyValue (nodeName, subCase) in union.Cases do + yield + SynLongIdent.create [ Ident.create nodeName ], + SynExpr.callMethod "_Empty" (SynExpr.createIdent' subCase.NameOfInProgressType) + ] + |> SynExpr.createRecord None + |> SynBinding.basic [ Ident.create "_Empty" ] [ SynPat.unit ] + |> SynBinding.withReturnAnnotation (SynType.createLongIdent [ union.NameOfInProgressType ]) + |> SynMemberDefn.staticMember + + { + Name = union.NameOfInProgressType + Fields = fields + Members = + [ Some assembleMethod ; Some emptyConstructor ; Some helpTextBinding ] + |> List.choose id + |> Some + XmlDoc = PreXmlDoc.create $"A partially-parsed %s{union.Original.Name.idText}." |> Some + Generics = + match union.Original.Generics with + | None -> None + | Some _ -> failwith $"Union type %s{union.Original.Name.idText} had generics, which we don't support." + TypeAccessibility = Some (SynAccess.Internal range0) + ImplAccessibility = None + Attributes = [] + } + type internal AllInfo = { /// Map of identifier to parser @@ -1574,6 +1706,8 @@ module internal ShibaGenerator = FlagDus : Map /// Map of identifier to DU information DatalessUnions : Map + /// The original order the types appeared in. + OriginalOrder : Ident list } /// Returns Error if we haven't yet obtained parse structures for the dependencies of this record. @@ -1670,6 +1804,7 @@ module internal ShibaGenerator = match field.Type with | SynType.LongIdent (SynLongIdent.SynLongIdent (id = id)) -> let desiredType = (List.last id).idText + match knownRecordTypes.TryGetValue desiredType with | false, _ -> Error $"Type not yet known: %s{desiredType}" | true, v -> Ok (case.Name.idText, v) @@ -1683,13 +1818,18 @@ module internal ShibaGenerator = { Original = ut Cases = x + NameOfInProgressType = ut.Name.idText + "_InProgress" |> Ident.create } ) - let internal parseStructureWithinNs (unions : UnionType list) (records : RecordType list) : AllInfo = + let internal parseStructureWithinNs + (unions : (UnionType * int) list) + (records : (RecordType * int) list) + : AllInfo + = let flagDus, datalessUnions, parserUnions = (([], [], []), unions) - ||> List.fold (fun (flagDus, datalessUnions, unions) union -> + ||> List.fold (fun (flagDus, datalessUnions, unions) (union, index) -> match union.Cases |> List.tryFind (fun case -> not case.Fields.IsEmpty) with | Some dataCarryingCase -> match union.Cases |> List.tryFind (fun case -> case.Fields.Length <> 1) with @@ -1698,7 +1838,7 @@ module internal ShibaGenerator = $"Unions must either be dataless or every field must have exactly one member. Type %s{union.Name.idText} has case %s{dataCarryingCase.Name.idText} with data, but case %s{badCase.Name.idText} doesn't have exactly one field." | None -> // OK, all cases have exactly one field. - flagDus, datalessUnions, union :: unions + flagDus, datalessUnions, (union, index) :: unions | None -> let datalessUnionBranch () = @@ -1779,7 +1919,7 @@ module internal ShibaGenerator = keepLoopingReason <- None let mutable madeAChange = false - for record in records do + for record, _ in records do if not (allKnownRecordTypes.ContainsKey record.Name.idText) then match parseRecord allKnownRecordTypes allKnownUnionTypes (flagDus |> List.map snd) record with | Error e -> keepLoopingReason <- Some e @@ -1787,7 +1927,7 @@ module internal ShibaGenerator = allKnownRecordTypes.Add (record.Name.idText, v) madeAChange <- true - for union in parserUnions do + for union, _ in parserUnions do if not (allKnownUnionTypes.ContainsKey union.Name.idText) then match parseUnion allKnownRecordTypes union with | Error e -> keepLoopingReason <- Some e @@ -1802,11 +1942,20 @@ module internal ShibaGenerator = failwith $"Cyclic dependency detected which we can't break. Known records:\n%s{knownRecords}\nKnown unions:\n%s{knownUnions}" + let originalOrder = + parserUnions + |> Seq.map (fun (union, index) -> union.Name, index) + |> Seq.append (records |> Seq.map (fun (record, index) -> record.Name, index)) + |> Seq.sortBy snd + |> Seq.map fst + |> List.ofSeq + { RecordParsers = allKnownRecordTypes UnionParsers = allKnownUnionTypes FlagDus = Map.ofList flagDus DatalessUnions = Map.ofList datalessUnions + OriginalOrder = originalOrder } let helperModuleName (namespaceName : LongIdent) : Ident = @@ -1823,14 +1972,18 @@ module internal ShibaGenerator = let flagDuNames = info.FlagDus.Keys - let reducedRecordTypes = - info.RecordParsers - |> Seq.map (fun (KeyValue (_, record)) -> inProgressRecordType record |> RecordType.ToAst) - |> Seq.toList - - let reducedUnionTypes = - info.UnionParsers - |> Seq.map (fun (KeyValue (_, union)) -> failwith "TODO") + // We need to make sure the parsers appear in the right order, to capture dependencies. + let types = + info.OriginalOrder + |> Seq.map (fun ident -> + match info.RecordParsers.TryGetValue ident.idText with + | true, v -> inProgressRecordType v |> RecordType.ToAst + | false, _ -> + + match info.UnionParsers.TryGetValue ident.idText with + | true, v -> inProgressUnionType v |> RecordType.ToAst + | false, _ -> failwith $"didn't make a parser for ident %s{ident.idText}" + ) |> Seq.toList let taggedMod = @@ -1839,7 +1992,7 @@ module internal ShibaGenerator = yield SynModuleDecl.openAny openStatement yield SynModuleDecl.openAny (SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create ns, range0)) - yield (reducedRecordTypes @ reducedUnionTypes) |> SynModuleDecl.createTypes + yield types |> SynModuleDecl.createTypes ] |> SynModuleDecl.nestedModule modInfo @@ -2135,20 +2288,15 @@ module internal ShibaGenerator = let createModule (opens : SynOpenDeclTarget list) (ns : LongIdent) - ((taggedType : SynTypeDefn, spec : ArgParserOutputSpec)) + ((taggedType : LongIdent, spec : ArgParserOutputSpec)) (helperModName : LongIdent) (structures : AllInfo) : 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." + match structures.RecordParsers.TryGetValue (List.last(taggedType).idText) with + | false, _ -> failwith "[] currently only supports being placed on records." + | true, v -> v.Original let taggedTypeInfo = structures.RecordParsers.[taggedType.Name.idText] @@ -2410,15 +2558,29 @@ type ShibaGenerator () = 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 types = Ast.getTypes ast |> List.map (fun (ns, types) -> ns, types) let opens = AstHelper.extractOpens ast let namespaceAndTypes = types - |> List.collect (fun (ns, types) -> + |> List.map (fun (ns, types) -> + let unions, records, _others, _ = + (([], [], [], 0), types) + ||> List.fold (fun + (unions, records, others, index) + (SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) -> + match repr with + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (access, cases, _), _) -> + (UnionType.OfUnion sci smd access cases, index) :: unions, records, others, index + 1 + | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _) -> + unions, + (RecordType.OfRecord sci smd access fields, index) :: records, + others, + index + 1 + | _ -> unions, records, ty :: others, index + 1 + ) + let typeWithAttr = types |> List.choose (fun ty -> @@ -2438,33 +2600,14 @@ type ShibaGenerator () = ExtensionMethods = arg } - Some (ty, spec) + let (SynTypeDefn (SynComponentInfo (longId = ident), _, _, _, _, _)) = ty + Some (ident, 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 a ShibaGenerator type must be discriminated unions or records. %+A{others}" - - (ns, taggedType, unions, records) - ) + ns, typeWithAttr, unions, records ) - let unionsAndRecordsByNs = + let allUnionsAndRecordsByNs = (Map.empty, namespaceAndTypes) ||> List.fold (fun types (ns, _, unions, records) -> let nsKey = ns |> List.map _.idText |> String.concat "." @@ -2479,14 +2622,14 @@ type ShibaGenerator () = ) ) - let structuresWithinNs = - unionsAndRecordsByNs + let allStructuresWithinNs = + allUnionsAndRecordsByNs |> Map.map (fun _ (us, rs) -> ShibaGenerator.parseStructureWithinNs us rs) let helperModNamespaceName = Ident.create "ArgParserHelpers" let helpersMod = - structuresWithinNs + allStructuresWithinNs |> Map.toSeq |> Seq.map (fun (ns, info) -> ShibaGenerator.createHelpersModule opens (ns.Split '.' |> Seq.map Ident.create |> List.ofSeq) info @@ -2497,17 +2640,20 @@ type ShibaGenerator () = let modules = namespaceAndTypes - |> List.map (fun (ns, taggedType, _, _) -> + |> List.collect (fun (ns, taggedTypes, _, _) -> let opens = SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create [ helperModNamespaceName ], range0) :: opens - ShibaGenerator.createModule - opens - ns - taggedType - [ ShibaGenerator.helperModuleName ns ] - structuresWithinNs.[ns |> List.map _.idText |> String.concat "."] + taggedTypes + |> List.map (fun taggedType -> + ShibaGenerator.createModule + opens + ns + taggedType + [ ShibaGenerator.helperModuleName ns ] + allStructuresWithinNs.[ns |> List.map _.idText |> String.concat "."] + ) ) Output.Ast (helpersMod :: modules)