mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-05 12:08:46 +00:00
WIP: define the helper types
This commit is contained in:
Smaug123
@@ -12,6 +12,7 @@
|
||||
<ItemGroup>
|
||||
<None Include="myriad.toml"/>
|
||||
<Compile Include="AssemblyInfo.fs" />
|
||||
<!--
|
||||
<Compile Include="RecordFile.fs"/>
|
||||
<Compile Include="GeneratedRecord.fs">
|
||||
<MyriadFile>RecordFile.fs</MyriadFile>
|
||||
@@ -66,10 +67,12 @@
|
||||
<Compile Include="ListCata.fs">
|
||||
<MyriadFile>List.fs</MyriadFile>
|
||||
</Compile>
|
||||
-->
|
||||
<Compile Include="Args.fs" />
|
||||
<Compile Include="GeneratedArgs.fs">
|
||||
<MyriadFile>Args.fs</MyriadFile>
|
||||
</Compile>
|
||||
<!--
|
||||
<None Include="swagger-gitea.json" />
|
||||
<Compile Include="GeneratedSwaggerGitea.fs">
|
||||
<MyriadFile>swagger-gitea.json</MyriadFile>
|
||||
@@ -81,6 +84,7 @@
|
||||
<Compile Include="Generated2SwaggerGitea.fs">
|
||||
<MyriadFile>GeneratedSwaggerGitea.fs</MyriadFile>
|
||||
</Compile>
|
||||
-->
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -45,4 +45,3 @@ type Args =
|
||||
[<PositionalArgs>]
|
||||
OtherArgs : string list
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
[<RequireQualifiedAccess; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||
module ArgsModule =
|
||||
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||
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<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 SubMode1 record
|
||||
type private State_SubMode1 =
|
||||
{
|
||||
mutable Info1 : int option
|
||||
mutable Info2 : string option
|
||||
Rest : ResizeArray<string> // 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<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
|
||||
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
|
||||
}
|
||||
|
||||
type private CandidateParseStateContents =
|
||||
| Mode1 of State_Mode1
|
||||
| Mode2 of State_Mode2
|
||||
static member Create () =
|
||||
{
|
||||
Info1 = None
|
||||
Info2 = None
|
||||
Rest = ResizeArray ()
|
||||
}
|
||||
|
||||
/// State for a single candidate parse path for the Modes DU
|
||||
type private CandidateParseState_Modes = {
|
||||
mutable IsViable : bool
|
||||
Errors : ResizeArray<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"
|
||||
}
|
||||
/// 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 =
|
||||
/// 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<int>()
|
||||
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 to DU candidates
|
||||
// Helper functions for applying args (applyKeyValueToSubModeXState unchanged)
|
||||
//----------------------------------------------------------------------
|
||||
let applyKeyValueToSubMode1State
|
||||
(argIndex : int)
|
||||
(keyIndex : int)
|
||||
(key : string)
|
||||
(value : string)
|
||||
(subState : State_SubMode1)
|
||||
(candidate : CandidateParseState_Modes)
|
||||
: unit
|
||||
=
|
||||
// ... (Implementation identical to previous version) ...
|
||||
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
||||
match subState.Info1 with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode1)")
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
try
|
||||
subState.Info1 <- Some (Int32.Parse value)
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Failed to parse '%s' for --info1 (SubMode1): %s" value ex.Message
|
||||
)
|
||||
|
||||
/// Tries to apply a key-value pair to a single candidate. Updates candidate state.
|
||||
let applyKeyValueToCandidate (argIndex: int, keyIndex: int, key: string, value: string) (candidate: CandidateParseState_Modes) : unit =
|
||||
if not candidate.IsViable then () else
|
||||
candidate.IsViable <- false
|
||||
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
||||
match subState.Info2 with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode1)")
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
subState.Info2 <- Some value
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
||||
subState.Rest.Add value
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
else
|
||||
()
|
||||
|
||||
match candidate.CaseState with
|
||||
| Mode1 state ->
|
||||
if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Things_Info1 with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--info1' supplied multiple times for Mode1 candidate"); candidate.IsViable <- false
|
||||
let applyKeyValueToSubMode2State
|
||||
(argIndex : int)
|
||||
(keyIndex : int)
|
||||
(key : string)
|
||||
(value : string)
|
||||
(subState : State_SubMode2)
|
||||
(candidate : CandidateParseState_Modes)
|
||||
: unit
|
||||
=
|
||||
// ... (Implementation identical to previous version) ...
|
||||
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
||||
match subState.Info1 with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode2)")
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
try
|
||||
subState.Info1 <- Some (Int32.Parse value)
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Failed to parse '%s' for --info1 (SubMode2): %s" value ex.Message
|
||||
)
|
||||
|
||||
candidate.IsViable <- false
|
||||
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
||||
match subState.Info2 with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode2)")
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
subState.Info2 <- Some value
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
||||
try
|
||||
subState.Rest.Add (Int32.Parse value)
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Failed to parse '%s' as int32 for --rest (SubMode2): %s" value ex.Message
|
||||
)
|
||||
|
||||
candidate.IsViable <- false
|
||||
else
|
||||
()
|
||||
|
||||
//----------------------------------------------------------------------
|
||||
// Routing and Main Application Logic (applyKeyValueToCandidate unchanged)
|
||||
//----------------------------------------------------------------------
|
||||
let applyKeyValueToCandidate
|
||||
(argIndex : int, keyIndex : int, key : string, value : string)
|
||||
(candidate : CandidateParseState_Modes)
|
||||
: unit
|
||||
=
|
||||
// ... (Implementation identical to previous version, calling sub-state helpers) ...
|
||||
if not candidate.IsViable then
|
||||
()
|
||||
else
|
||||
|
||||
match candidate.CaseName with
|
||||
| "Mode1" ->
|
||||
let state = candidate.CaseState :?> State_Mode1
|
||||
|
||||
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Whatnot with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Argument '--whatnot' supplied multiple times for Mode1 candidate"
|
||||
)
|
||||
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
try state.Things_Info1 <- Some(Int32.Parse value); candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex -> candidate.Errors.Add(sprintf "Failed to parse '%s' for --info1 (Mode1): %s" value ex.Message); candidate.IsViable <- false
|
||||
elif String.Equals(key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Things_Info2 with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--info2' supplied multiple times for Mode1 candidate"); candidate.IsViable <- false
|
||||
| None -> state.Things_Info2 <- Some value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
elif String.Equals(key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
||||
// String list for Mode1
|
||||
state.Things_Rest.Add value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
elif String.Equals(key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Whatnot with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--whatnot' supplied multiple times for Mode1 candidate"); candidate.IsViable <- false
|
||||
| None ->
|
||||
try state.Whatnot <- Some(Int32.Parse value); candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex -> candidate.Errors.Add(sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message); candidate.IsViable <- false
|
||||
else
|
||||
// Key not relevant to Mode1, ignore it for this candidate
|
||||
()
|
||||
try
|
||||
state.Whatnot <- Some (Int32.Parse value)
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message
|
||||
)
|
||||
|
||||
| Mode2 state ->
|
||||
if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Things_Info1 with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--info1' supplied multiple times for Mode2 candidate"); candidate.IsViable <- false
|
||||
candidate.IsViable <- false
|
||||
elif key = "--info1" || key = "--info2" || key = "--rest" then
|
||||
applyKeyValueToSubMode1State argIndex keyIndex key value state.ThingsState candidate
|
||||
else
|
||||
()
|
||||
| "Mode2" ->
|
||||
let state = candidate.CaseState :?> State_Mode2
|
||||
|
||||
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Whatnot with
|
||||
| Some _ ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Argument '--whatnot' supplied multiple times for Mode2 candidate"
|
||||
)
|
||||
|
||||
candidate.IsViable <- false
|
||||
| None ->
|
||||
try state.Things_Info1 <- Some(Int32.Parse value); candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex -> candidate.Errors.Add(sprintf "Failed to parse '%s' for --info1 (Mode2): %s" value ex.Message); candidate.IsViable <- false
|
||||
elif String.Equals(key, "--info2", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Things_Info2 with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--info2' supplied multiple times for Mode2 candidate"); candidate.IsViable <- false
|
||||
| None -> state.Things_Info2 <- Some value; candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
elif String.Equals(key, "--rest", StringComparison.OrdinalIgnoreCase) then
|
||||
// Int list for Mode2
|
||||
try state.Things_Rest.Add(Int32.Parse value); candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex -> candidate.Errors.Add(sprintf "Failed to parse '%s' as int32 for --rest (Mode2): %s" value ex.Message); candidate.IsViable <- false
|
||||
elif String.Equals(key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
|
||||
match state.Whatnot with
|
||||
| Some _ -> candidate.Errors.Add(sprintf "Argument '--whatnot' supplied multiple times for Mode2 candidate"); candidate.IsViable <- false
|
||||
| None ->
|
||||
try state.Whatnot <- Some(DateTime.Parse value); candidate.ConsumedArgIndices.Add argIndex |> ignore; candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex -> candidate.Errors.Add(sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message); candidate.IsViable <- false
|
||||
else
|
||||
// Key not relevant to Mode2, ignore it for this candidate
|
||||
()
|
||||
try
|
||||
state.Whatnot <- Some (DateTime.Parse value)
|
||||
candidate.ConsumedArgIndices.Add argIndex |> ignore
|
||||
candidate.ConsumedArgIndices.Add keyIndex |> ignore
|
||||
with ex ->
|
||||
candidate.Errors.Add (
|
||||
sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message
|
||||
)
|
||||
|
||||
/// Processes a key-value pair across all candidates. Returns true if handled by *any* viable candidate.
|
||||
let processKeyValue (keyIndex: int, key: string, valueIndex: int, value: string) : bool =
|
||||
candidate.IsViable <- false
|
||||
elif key = "--info1" || key = "--info2" || key = "--rest" then
|
||||
applyKeyValueToSubMode2State argIndex keyIndex key value state.ThingsState candidate
|
||||
else
|
||||
()
|
||||
| _ -> failwith "Internal error: Unknown case name"
|
||||
|
||||
// processKeyValue, setFlagValue, and main loop `go` are identical to previous version
|
||||
let processKeyValue (keyIndex : int, key : string, valueIndex : int, value : string) : bool =
|
||||
let mutable handled = false
|
||||
|
||||
for candidate in candidates_WhatToDo do
|
||||
let initialConsumedCount = candidate.ConsumedArgIndices.Count
|
||||
applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate
|
||||
|
||||
if candidate.IsViable then
|
||||
applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate
|
||||
|
||||
if candidate.IsViable && candidate.ConsumedArgIndices.Count > initialConsumedCount then
|
||||
// Mark as handled if *any* viable candidate consumed it
|
||||
handled <- true
|
||||
// Add consumed indices to the global set for leftover detection later
|
||||
consumedArgIndices_WhatToDo.Add keyIndex |> ignore
|
||||
consumedArgIndices_WhatToDo.Add valueIndex |> ignore
|
||||
|
||||
handled
|
||||
|
||||
/// Processes a flag across all candidates. Returns true if handled by *any* viable candidate.
|
||||
/// Note: No boolean flags defined in this example, so this is trivial.
|
||||
let setFlagValue (keyIndex: int, key: string) : bool =
|
||||
let mutable handled = false
|
||||
// Example: If --info1 were a flag for Mode1
|
||||
// for candidate in candidates_WhatToDo do
|
||||
// if candidate.IsViable && candidate.CaseName = "Mode1" then
|
||||
// let state = candidate.CaseState :?> State_Mode1
|
||||
// if String.Equals(key, "--info1", StringComparison.OrdinalIgnoreCase) then
|
||||
// match state.Things_Info1 with // Assuming it was bool option
|
||||
// | Some _ -> candidate.Errors.Add(...) ; candidate.IsViable <- false
|
||||
// | None -> state.Things_Info1 <- Some true; candidate.ConsumedArgIndices.Add keyIndex |> ignore; handled <- true
|
||||
// if handled then consumedArgIndices_WhatToDo.Add keyIndex |> ignore
|
||||
handled // No flags in this specific schema
|
||||
let setFlagValue (keyIndex : int) (key : string) : bool = false // No flags
|
||||
|
||||
|
||||
//----------------------------------------------------------------------
|
||||
// Main parsing loop
|
||||
//----------------------------------------------------------------------
|
||||
let rec go (state: ParseState_Args) (args: (int * string) list) =
|
||||
let rec go (state : ParseState_Args) (args : (int * string) list) =
|
||||
// ... (Implementation identical to previous version) ...
|
||||
match args with
|
||||
| [] -> // End of arguments
|
||||
| [] ->
|
||||
match state with
|
||||
| ParseState_Args.AwaitingArg -> () // Expected state
|
||||
| ParseState_Args.AwaitingValue (keyIndex, key) ->
|
||||
// Trailing key without value
|
||||
if not (setFlagValue (keyIndex, key)) then
|
||||
// Not a flag either, report error
|
||||
ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." key keyIndex)
|
||||
|
||||
| (argIndex, arg) :: remainingArgs ->
|
||||
| ParseState_Args.AwaitingArg -> ()
|
||||
| ParseState_Args.AwaitingValue (i, k) ->
|
||||
if not (setFlagValue i k) then
|
||||
ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." k i)
|
||||
| (idx, arg) :: rest ->
|
||||
match state with
|
||||
| ParseState_Args.AwaitingArg ->
|
||||
if arg = "--" then
|
||||
// Consume rest as positional
|
||||
remainingArgs |> List.iter (fun (i, positionalArg) ->
|
||||
// Check if arg was potentially consumed by DU before adding
|
||||
rest
|
||||
|> List.iter (fun (i, v) ->
|
||||
if not (consumedArgIndices_WhatToDo.Contains i) then
|
||||
arg_OtherArgs.Add positionalArg
|
||||
arg_OtherArgs.Add v
|
||||
)
|
||||
go ParseState_Args.AwaitingArg [] // Go to end state
|
||||
|
||||
elif arg.StartsWith("--", StringComparison.Ordinal) then
|
||||
go ParseState_Args.AwaitingArg []
|
||||
elif arg.StartsWith ("--") then
|
||||
if arg = "--help" then
|
||||
helpText () |> failwithf "Help text requested.\n%s"
|
||||
helpText () |> failwithf "Help text requested:\n%s"
|
||||
else
|
||||
let equalsPos = arg.IndexOf('=')
|
||||
if equalsPos > 0 then
|
||||
// --key=value format
|
||||
let key = arg.[0 .. equalsPos - 1]
|
||||
let value = arg.[equalsPos + 1 ..]
|
||||
if not (processKeyValue (argIndex, key, argIndex, value)) then
|
||||
// Key-value not handled by DU candidates, check if it belongs elsewhere (none in this example)
|
||||
// If still not handled, consider it potentially positional only if not consumed by DU
|
||||
if not (consumedArgIndices_WhatToDo.Contains argIndex) then
|
||||
arg_OtherArgs.Add arg // Treat unhandled --key=value as positional
|
||||
go ParseState_Args.AwaitingArg remainingArgs
|
||||
let eq = arg.IndexOf ('=')
|
||||
|
||||
if eq > 0 then
|
||||
let k = arg.[.. eq - 1]
|
||||
let v = arg.[eq + 1 ..]
|
||||
|
||||
if not (processKeyValue (idx, k, idx, v)) then
|
||||
if not (consumedArgIndices_WhatToDo.Contains idx) then
|
||||
arg_OtherArgs.Add arg
|
||||
|
||||
go ParseState_Args.AwaitingArg rest
|
||||
elif setFlagValue idx arg then
|
||||
consumedArgIndices_WhatToDo.Add idx |> ignore
|
||||
go ParseState_Args.AwaitingArg rest
|
||||
else
|
||||
// --key format (potential flag or key needing subsequent value)
|
||||
if setFlagValue (argIndex, arg) then
|
||||
consumedArgIndices_WhatToDo.Add argIndex |> ignore
|
||||
go ParseState_Args.AwaitingArg remainingArgs // Flag consumed
|
||||
else
|
||||
go (ParseState_Args.AwaitingValue (argIndex, arg)) remainingArgs // Expect value next
|
||||
|
||||
else // Positional argument
|
||||
// Add positional arg *only if* it hasn't been consumed by the DU logic
|
||||
if not (consumedArgIndices_WhatToDo.Contains argIndex) then
|
||||
go (ParseState_Args.AwaitingValue (idx, arg)) rest
|
||||
else
|
||||
if not (consumedArgIndices_WhatToDo.Contains idx) then
|
||||
arg_OtherArgs.Add arg
|
||||
go ParseState_Args.AwaitingArg remainingArgs
|
||||
|
||||
| ParseState_Args.AwaitingValue (keyIndex, key) ->
|
||||
// We have a key, current arg is its potential value
|
||||
if processKeyValue (keyIndex, key, argIndex, arg) then
|
||||
go ParseState_Args.AwaitingArg remainingArgs // Key-value pair consumed
|
||||
else
|
||||
// Value wasn't parseable/applicable for the key via DU candidates.
|
||||
// Could the key have been a flag?
|
||||
if setFlagValue (keyIndex, key) then
|
||||
consumedArgIndices_WhatToDo.Add keyIndex |> ignore
|
||||
// Flag consumed, reprocess the current arg in AwaitingArg state
|
||||
go ParseState_Args.AwaitingArg ((argIndex, arg) :: remainingArgs)
|
||||
else
|
||||
// Not a flag, not a valid value. Error reported by processKeyValue/apply...
|
||||
// Treat *both* key and arg as positional if not consumed by DU.
|
||||
if not (consumedArgIndices_WhatToDo.Contains keyIndex) then
|
||||
arg_OtherArgs.Add key
|
||||
if not (consumedArgIndices_WhatToDo.Contains argIndex) then
|
||||
arg_OtherArgs.Add arg
|
||||
go ParseState_Args.AwaitingArg remainingArgs
|
||||
go ParseState_Args.AwaitingArg rest
|
||||
| ParseState_Args.AwaitingValue (keyIdx, key) ->
|
||||
if processKeyValue (keyIdx, key, idx, arg) then
|
||||
go ParseState_Args.AwaitingArg rest
|
||||
elif setFlagValue keyIdx key then
|
||||
consumedArgIndices_WhatToDo.Add keyIdx |> ignore<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
|
||||
// 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<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 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
|
||||
|
||||
@@ -1,11 +1,10 @@
|
||||
namespace Playground
|
||||
|
||||
open GeneratedParsers
|
||||
|
||||
module Program =
|
||||
[<EntryPoint>]
|
||||
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
|
||||
|
||||
629
WoofWare.Myriad.Plugins/ShibaGenerator.fs
Normal file
629
WoofWare.Myriad.Plugins/ShibaGenerator.fs
Normal file
@@ -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<int, int> }`, 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<FlagDu, unit> 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
|
||||
"[<ArgumentFlag>] 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
|
||||
"[<ArgumentFlag>] 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 "[<ArgumentFlag>] 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 "[<ArgParser>] 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.
|
||||
[<MyriadGenerator("arg-parser")>]
|
||||
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<ArgParserAttribute>.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)
|
||||
@@ -40,7 +40,8 @@
|
||||
<Compile Include="JsonParseGenerator.fs"/>
|
||||
<Compile Include="HttpClientGenerator.fs"/>
|
||||
<Compile Include="CataGenerator.fs" />
|
||||
<Compile Include="ArgParserGenerator.fs" />
|
||||
<None Include="ArgParserGenerator.fs" />
|
||||
<Compile Include="ShibaGenerator.fs" />
|
||||
<Compile Include="Swagger.fs" />
|
||||
<Compile Include="SwaggerClientGenerator.fs" />
|
||||
<None Include="ApacheLicence.txt" />
|
||||
|
||||
Reference in New Issue
Block a user