patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-06 04:28:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

WIP: complete arg parser

Browse Source
This commit is contained in:
Smaug123
2025-04-13 11:52:17 +01:00
parent 71f26930c6
commit fa022b75ea
6 changed files with 443 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
Directory.Build.props
View File

@@ -8,6 +8,7 @@
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<DebugType>embedded</DebugType>
<WarnOn>FS3388,FS3559</WarnOn>
<NoWarn>$(NoWarn),NU1900</NoWarn>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Nerdbank.GitVersioning" Version="3.8.38-alpha" PrivateAssets="all"/>

48
Playground/Domain.fs Normal file
View File

@@ -0,0 +1,48 @@
namespace Playground
open System
open WoofWare.Myriad.Plugins
[<ArgParser>]
type SubMode1 =
{
Info1 : int
Info2 : string
Rest : string list
}
[<ArgParser>]
type SubMode2 =
{
Info1 : int
Info2 : string
Rest : int list
}
[<ArgParser>]
type Mode1 =
{
Things : SubMode1
Whatnot : int
}
[<ArgParser>]
type Mode2 =
{
Things : SubMode2
Whatnot : DateTime
}
[<ArgParser>]
type Modes =
| Mode1 of Mode1
| Mode2 of Mode2
[<ArgParser>]
type Args =
{
WhatToDo : Modes
[<PositionalArgs>]
OtherArgs : string list
}

358
Playground/Library.fs Normal file
View File

@@ -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
// [<ArgParser>] type SubMode1 = { Info1 : int; Info2 : string; Rest : string list }
// [<ArgParser>] type SubMode2 = { Info1 : int; Info2 : string; Rest : int list }
// [<ArgParser>] type Mode1 = { Things : SubMode1; Whatnot : int }
// [<ArgParser>] type Mode2 = { Things : SubMode2; Whatnot : DateTime }
// [<ArgParser>] type Modes = | Mode1 of Mode1 | Mode2 of Mode2
// [<ArgParser>] type Args = { WhatToDo : Modes; [<PositionalArgs>] OtherArgs : string list }
/// Methods to parse arguments for the type Args
[<RequireQualifiedAccess; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
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<string> // 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<int> // 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<string> // Errors specific to this candidate's path
ConsumedArgIndices : System.Collections.Generic.HashSet<int> // 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<int>()
//----------------------------------------------------------------------
// 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<string>()
// 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

19
Playground/Playground.fsproj Normal file
View File

@@ -0,0 +1,19 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net9.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<OutputType>Exe</OutputType>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
<Compile Include="Library.fs"/>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes\WoofWare.Myriad.Plugins.Attributes.fsproj" />
</ItemGroup>
</Project>

11
Playground/Program.fs Normal file
View File

@@ -0,0 +1,11 @@
namespace Playground
open GeneratedParsers
module Program =
[<EntryPoint>]
let main argv =
["--whatnot=2024-01-12";"--info1=4";"--info2=hi"]
|> ArgsModule.parse
|> printfn "%O"
0

6
WoofWare.Myriad.sln
View File

@@ -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