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] 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 f0daa0b..506a07b 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 0000000..425d27b --- /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 0000000..7dd7900 --- /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 0000000..cddb718 --- /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 0000000..a96d3b5 --- /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 61d3d2b..14f8b81 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