mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-11 06:58:42 +00:00
564 lines
24 KiB
Forth
564 lines
24 KiB
Forth
//------------------------------------------------------------------------------
|
|
// This code was generated by myriad.
|
|
// Changes to this file will be lost when the code is regenerated.
|
|
//------------------------------------------------------------------------------
|
|
|
|
namespace Playground // Assuming a namespace
|
|
|
|
open System
|
|
open System.IO
|
|
open WoofWare.Myriad.Plugins // Assuming attributes are here
|
|
|
|
// Assume original type definitions are accessible here
|
|
// [<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 Args =
|
|
|
|
//--------------------------------------------------------------------------
|
|
// Internal state definitions (Non-Flattened with combined Assemble/Validate)
|
|
//--------------------------------------------------------------------------
|
|
|
|
/// State representing the parse progress for SubMode1 record
|
|
type private State_SubMode1 =
|
|
{
|
|
mutable Info1 : int option
|
|
mutable Info2 : string option
|
|
Rest : ResizeArray<string> // Corresponds to --rest
|
|
}
|
|
|
|
static member Create () =
|
|
{
|
|
Info1 = None
|
|
Info2 = None
|
|
Rest = ResizeArray ()
|
|
}
|
|
|
|
/// Check completeness and assemble the SubMode1 record from state.
|
|
member this.Assemble () : Result<SubMode1, string list> =
|
|
let errors = ResizeArray<string> ()
|
|
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<int> // Corresponds to --rest
|
|
}
|
|
|
|
static member Create () =
|
|
{
|
|
Info1 = None
|
|
Info2 = None
|
|
Rest = ResizeArray ()
|
|
}
|
|
|
|
/// Check completeness and assemble the SubMode2 record from state.
|
|
member this.Assemble () : Result<SubMode2, string list> =
|
|
let errors = ResizeArray<string> ()
|
|
|
|
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<Mode1, string list> =
|
|
let errors = ResizeArray<string> ()
|
|
|
|
// 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<Mode2, string list> =
|
|
let errors = ResizeArray<string> ()
|
|
|
|
// 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<string> // Errors specific to this candidate's path
|
|
ConsumedArgIndices : System.Collections.Generic.HashSet<int> // Indices consumed *by this candidate*
|
|
CaseState : obj // Holds either State_Mode1 or State_Mode2
|
|
}
|
|
|
|
static member CreateMode1 () =
|
|
{
|
|
CaseName = "Mode1"
|
|
IsViable = true
|
|
Errors = ResizeArray ()
|
|
ConsumedArgIndices = System.Collections.Generic.HashSet ()
|
|
CaseState = State_Mode1.Create () :> obj
|
|
}
|
|
|
|
static member CreateMode2 () =
|
|
{
|
|
CaseName = "Mode2"
|
|
IsViable = true
|
|
Errors = ResizeArray ()
|
|
ConsumedArgIndices = System.Collections.Generic.HashSet ()
|
|
CaseState = State_Mode2.Create () :> obj
|
|
}
|
|
|
|
//--------------------------------------------------------------------------
|
|
// Main Parser Logic
|
|
//--------------------------------------------------------------------------
|
|
|
|
type private ParseState_Args =
|
|
| AwaitingArg
|
|
| AwaitingValue of keyIndex : int * key : string
|
|
|
|
let parse' (getEnvironmentVariable : string -> string) (args : string list) : Args =
|
|
let ArgParser_errors = ResizeArray () // Global errors accumulator
|
|
|
|
let helpText () =
|
|
// Help text generation unchanged
|
|
[
|
|
(sprintf "%s int32%s%s" (sprintf "--%s" "info1") "" " (for Mode1/Mode2 Things)")
|
|
(sprintf "%s string%s%s" (sprintf "--%s" "info2") "" " (for Mode1/Mode2 Things)")
|
|
(sprintf "%s string%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode1 Things)")
|
|
(sprintf "%s int32%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode2 Things)")
|
|
(sprintf "%s int32%s%s" (sprintf "--%s" "whatnot") "" " (for Mode1)")
|
|
(sprintf "%s DateTime%s%s" (sprintf "--%s" "whatnot") "" " (for Mode2)")
|
|
(sprintf "%s string%s%s" (sprintf "--%s" "other-args") " (positional args) (can be repeated)" "")
|
|
]
|
|
|> String.concat "\n"
|
|
|
|
let arg_OtherArgs : string ResizeArray = ResizeArray ()
|
|
|
|
let mutable candidates_WhatToDo : CandidateParseState_Modes list =
|
|
[
|
|
CandidateParseState_Modes.CreateMode1 ()
|
|
CandidateParseState_Modes.CreateMode2 ()
|
|
]
|
|
|
|
let consumedArgIndices_WhatToDo = System.Collections.Generic.HashSet<int> ()
|
|
|
|
//----------------------------------------------------------------------
|
|
// Helper functions for applying args (applyKeyValueToSubModeXState unchanged)
|
|
//----------------------------------------------------------------------
|
|
let applyKeyValueToSubMode1State
|
|
(argIndex : int)
|
|
(keyIndex : int)
|
|
(key : string)
|
|
(value : string)
|
|
(subState : State_SubMode1)
|
|
(candidate : CandidateParseState_Modes)
|
|
: unit
|
|
=
|
|
// ... (Implementation identical to previous version) ...
|
|
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
|
match subState.Info1 with
|
|
| Some _ ->
|
|
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode1)")
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
try
|
|
subState.Info1 <- Some (Int32.Parse value)
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
with ex ->
|
|
candidate.Errors.Add (
|
|
sprintf "Failed to parse '%s' for --info1 (SubMode1): %s" value ex.Message
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
|
match subState.Info2 with
|
|
| Some _ ->
|
|
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode1)")
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
subState.Info2 <- Some value
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
|
subState.Rest.Add value
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
else
|
|
()
|
|
|
|
let applyKeyValueToSubMode2State
|
|
(argIndex : int)
|
|
(keyIndex : int)
|
|
(key : string)
|
|
(value : string)
|
|
(subState : State_SubMode2)
|
|
(candidate : CandidateParseState_Modes)
|
|
: unit
|
|
=
|
|
// ... (Implementation identical to previous version) ...
|
|
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
|
match subState.Info1 with
|
|
| Some _ ->
|
|
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode2)")
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
try
|
|
subState.Info1 <- Some (Int32.Parse value)
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
with ex ->
|
|
candidate.Errors.Add (
|
|
sprintf "Failed to parse '%s' for --info1 (SubMode2): %s" value ex.Message
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
|
match subState.Info2 with
|
|
| Some _ ->
|
|
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode2)")
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
subState.Info2 <- Some value
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
|
try
|
|
subState.Rest.Add (Int32.Parse value)
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
with ex ->
|
|
candidate.Errors.Add (
|
|
sprintf "Failed to parse '%s' as int32 for --rest (SubMode2): %s" value ex.Message
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
else
|
|
()
|
|
|
|
//----------------------------------------------------------------------
|
|
// Routing and Main Application Logic (applyKeyValueToCandidate unchanged)
|
|
//----------------------------------------------------------------------
|
|
let applyKeyValueToCandidate
|
|
(argIndex : int, keyIndex : int, key : string, value : string)
|
|
(candidate : CandidateParseState_Modes)
|
|
: unit
|
|
=
|
|
// ... (Implementation identical to previous version, calling sub-state helpers) ...
|
|
if not candidate.IsViable then
|
|
()
|
|
else
|
|
|
|
match candidate.CaseName with
|
|
| "Mode1" ->
|
|
let state = candidate.CaseState :?> State_Mode1
|
|
|
|
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
|
match state.Whatnot with
|
|
| Some _ ->
|
|
candidate.Errors.Add (
|
|
sprintf "Argument '--whatnot' supplied multiple times for Mode1 candidate"
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
try
|
|
state.Whatnot <- Some (Int32.Parse value)
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
with ex ->
|
|
candidate.Errors.Add (
|
|
sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
elif key = "--info1" || key = "--info2" || key = "--rest" then
|
|
applyKeyValueToSubMode1State argIndex keyIndex key value state.ThingsState candidate
|
|
else
|
|
()
|
|
| "Mode2" ->
|
|
let state = candidate.CaseState :?> State_Mode2
|
|
|
|
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
|
match state.Whatnot with
|
|
| Some _ ->
|
|
candidate.Errors.Add (
|
|
sprintf "Argument '--whatnot' supplied multiple times for Mode2 candidate"
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
| None ->
|
|
try
|
|
state.Whatnot <- Some (DateTime.Parse value)
|
|
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
|
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
|
with ex ->
|
|
candidate.Errors.Add (
|
|
sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message
|
|
)
|
|
|
|
candidate.IsViable <- false
|
|
elif key = "--info1" || key = "--info2" || key = "--rest" then
|
|
applyKeyValueToSubMode2State argIndex keyIndex key value state.ThingsState candidate
|
|
else
|
|
()
|
|
| _ -> failwith "Internal error: Unknown case name"
|
|
|
|
// processKeyValue, setFlagValue, and main loop `go` are identical to previous version
|
|
let processKeyValue (keyIndex : int, key : string, valueIndex : int, value : string) : bool =
|
|
let mutable handled = false
|
|
|
|
for candidate in candidates_WhatToDo do
|
|
let initialConsumedCount = candidate.ConsumedArgIndices.Count
|
|
|
|
if candidate.IsViable then
|
|
applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate
|
|
|
|
if candidate.IsViable && candidate.ConsumedArgIndices.Count > initialConsumedCount then
|
|
handled <- true
|
|
consumedArgIndices_WhatToDo.Add keyIndex |> ignore
|
|
consumedArgIndices_WhatToDo.Add valueIndex |> ignore
|
|
|
|
handled
|
|
|
|
let setFlagValue (keyIndex : int) (key : string) : bool = false // No flags
|
|
|
|
let rec go (state : ParseState_Args) (args : (int * string) list) =
|
|
// ... (Implementation identical to previous version) ...
|
|
match args with
|
|
| [] ->
|
|
match state with
|
|
| ParseState_Args.AwaitingArg -> ()
|
|
| ParseState_Args.AwaitingValue (i, k) ->
|
|
if not (setFlagValue i k) then
|
|
ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." k i)
|
|
| (idx, arg) :: rest ->
|
|
match state with
|
|
| ParseState_Args.AwaitingArg ->
|
|
if arg = "--" then
|
|
rest
|
|
|> List.iter (fun (i, v) ->
|
|
if not (consumedArgIndices_WhatToDo.Contains i) then
|
|
arg_OtherArgs.Add v
|
|
)
|
|
|
|
go ParseState_Args.AwaitingArg []
|
|
elif arg.StartsWith ("--") then
|
|
if arg = "--help" then
|
|
helpText () |> failwithf "Help text requested:\n%s"
|
|
else
|
|
let eq = arg.IndexOf ('=')
|
|
|
|
if eq > 0 then
|
|
let k = arg.[.. eq - 1]
|
|
let v = arg.[eq + 1 ..]
|
|
|
|
if not (processKeyValue (idx, k, idx, v)) then
|
|
if not (consumedArgIndices_WhatToDo.Contains idx) then
|
|
arg_OtherArgs.Add arg
|
|
|
|
go ParseState_Args.AwaitingArg rest
|
|
elif setFlagValue idx arg then
|
|
consumedArgIndices_WhatToDo.Add idx |> ignore
|
|
go ParseState_Args.AwaitingArg rest
|
|
else
|
|
go (ParseState_Args.AwaitingValue (idx, arg)) rest
|
|
else
|
|
if not (consumedArgIndices_WhatToDo.Contains idx) then
|
|
arg_OtherArgs.Add arg
|
|
|
|
go ParseState_Args.AwaitingArg rest
|
|
| ParseState_Args.AwaitingValue (keyIdx, key) ->
|
|
if processKeyValue (keyIdx, key, idx, arg) then
|
|
go ParseState_Args.AwaitingArg rest
|
|
elif setFlagValue keyIdx key then
|
|
consumedArgIndices_WhatToDo.Add keyIdx |> ignore<bool>
|
|
go ParseState_Args.AwaitingArg ((idx, arg) :: rest) // Reprocess arg
|
|
elif not (consumedArgIndices_WhatToDo.Contains keyIdx) then
|
|
arg_OtherArgs.Add key
|
|
|
|
if not (consumedArgIndices_WhatToDo.Contains idx) then
|
|
arg_OtherArgs.Add arg
|
|
|
|
go ParseState_Args.AwaitingArg rest
|
|
|
|
args |> List.mapi (fun i s -> (i, s)) |> go ParseState_Args.AwaitingArg
|
|
|
|
//----------------------------------------------------------------------
|
|
// Final Validation and Assembly (Uses new Assemble methods)
|
|
//----------------------------------------------------------------------
|
|
let viableWinners = candidates_WhatToDo |> List.filter (fun c -> c.IsViable)
|
|
// No longer filter based on IsComplete here; Assemble handles it.
|
|
// Still need to check for relative leftovers if that logic were implemented.
|
|
|
|
let whatToDoResult =
|
|
match viableWinners with
|
|
| [] ->
|
|
// Add specific errors from candidates that were viable *before* Assemble check
|
|
ArgParser_errors.Add ("No valid parse found for 'WhatToDo'.")
|
|
|
|
candidates_WhatToDo
|
|
|> List.iter (fun c ->
|
|
if c.Errors.Count <> 0 then
|
|
ArgParser_errors.Add (
|
|
sprintf " Candidate %s parse errors: %s" c.CaseName (String.concat "; " c.Errors)
|
|
)
|
|
// Potentially try to Assemble even non-viable ones to get completion errors? Maybe too complex.
|
|
)
|
|
|
|
Unchecked.defaultof<_> // Error path
|
|
|
|
| [ winner ] ->
|
|
// Assemble the winning case, checking the Result for completion errors
|
|
match winner.CaseName with
|
|
| "Mode1" ->
|
|
match (winner.CaseState :?> State_Mode1).Assemble () with
|
|
| Ok mode1Value -> Modes.Mode1 mode1Value
|
|
| Error completionErrors ->
|
|
ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode1:")
|
|
ArgParser_errors.AddRange completionErrors
|
|
Unchecked.defaultof<_> // Error path
|
|
| "Mode2" ->
|
|
match (winner.CaseState :?> State_Mode2).Assemble () with
|
|
| Ok mode2Value -> Modes.Mode2 mode2Value
|
|
| Error completionErrors ->
|
|
ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode2:")
|
|
ArgParser_errors.AddRange completionErrors
|
|
Unchecked.defaultof<_> // Error path
|
|
| _ -> failwith "Internal error: Unknown winning case name"
|
|
|
|
| winners -> // Ambiguous parse
|
|
ArgParser_errors.Add ("Ambiguous parse for 'WhatToDo'. Multiple modes potentially viable:")
|
|
|
|
winners
|
|
|> List.iter (fun c ->
|
|
ArgParser_errors.Add (
|
|
sprintf
|
|
" - %s (Initial Errors: %s)"
|
|
c.CaseName
|
|
(if c.Errors.Count = 0 then
|
|
"None"
|
|
else
|
|
String.concat "; " c.Errors)
|
|
)
|
|
)
|
|
|
|
Unchecked.defaultof<_> // Error path
|
|
|
|
// Finalize OtherArgs (unchanged)
|
|
let otherArgsResult = arg_OtherArgs |> Seq.toList
|
|
|
|
// Assemble Final Result or Fail (unchanged)
|
|
if ArgParser_errors.Count > 0 then
|
|
ArgParser_errors
|
|
|> String.concat "\n"
|
|
|> failwithf "Errors during parse!\n%s\n\nHelp Text:\n%s" (helpText ())
|
|
else
|
|
{
|
|
WhatToDo = whatToDoResult
|
|
OtherArgs = otherArgsResult
|
|
}
|
|
|
|
let parse (args : string list) : Args =
|
|
parse' System.Environment.GetEnvironmentVariable args
|