patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-11 15:08:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

WIP

Browse Source
This commit is contained in:
Smaug123
2025-04-14 00:01:55 +01:00
parent 8535481e0d
commit 0c5ddf9df7
5 changed files with 740 additions and 360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
ConsumePlugin/GeneratedArgs.fs
View File

@@ -20,10 +20,10 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed BasicNoPositionals.
type private BasicNoPositionals_InProgress =
{
Foo : System.Int32 option
Bar : System.String option
Baz : System.Boolean option
Rest : string list
mutable Foo : System.Int32 option
mutable Bar : System.String option
mutable Baz : System.Boolean option
mutable Rest : string list
}
member this.Assemble (positionals : string list) : Result<BasicNoPositionals, string list> =
@@ -66,9 +66,9 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed Basic.
type private Basic_InProgress =
{
Foo : System.Int32 option
Bar : System.String option
Baz : System.Boolean option
mutable Foo : System.Int32 option
mutable Bar : System.String option
mutable Baz : System.Boolean option
}
member this.Assemble (positionals : string list) : Result<Basic, string list> =
@@ -112,9 +112,9 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed BasicWithIntPositionals.
type private BasicWithIntPositionals_InProgress =
{
Foo : System.Int32 option
Bar : System.String option
Baz : System.Boolean option
mutable Foo : System.Int32 option
mutable Bar : System.String option
mutable Baz : System.Boolean option
}
member this.Assemble (positionals : string list) : Result<BasicWithIntPositionals, string list> =
@@ -158,16 +158,16 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed LoadsOfTypes.
type private LoadsOfTypes_InProgress =
{
Foo : System.Int32 option
Bar : System.String option
Baz : System.Boolean option
SomeFile : FileInfo option
SomeDirectory : DirectoryInfo option
SomeList : string list
OptionalThingWithNoDefault : int option
OptionalThing : bool option
AnotherOptionalThing : int option
YetAnotherOptionalThing : string option
mutable Foo : System.Int32 option
mutable Bar : System.String option
mutable Baz : System.Boolean option
mutable SomeFile : FileInfo option
mutable SomeDirectory : DirectoryInfo option
mutable SomeList : string list
mutable OptionalThingWithNoDefault : int option
mutable OptionalThing : bool option
mutable AnotherOptionalThing : int option
mutable YetAnotherOptionalThing : string option
}
member this.Assemble (positionals : string list) : Result<LoadsOfTypes, string list> =
@@ -249,16 +249,16 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed LoadsOfTypesNoPositionals.
type private LoadsOfTypesNoPositionals_InProgress =
{
Foo : System.Int32 option
Bar : System.String option
Baz : System.Boolean option
SomeFile : FileInfo option
SomeDirectory : DirectoryInfo option
SomeList : string list
OptionalThingWithNoDefault : int option
OptionalThing : bool option
AnotherOptionalThing : int option
YetAnotherOptionalThing : string option
mutable Foo : System.Int32 option
mutable Bar : System.String option
mutable Baz : System.Boolean option
mutable SomeFile : FileInfo option
mutable SomeDirectory : DirectoryInfo option
mutable SomeList : string list
mutable OptionalThingWithNoDefault : int option
mutable OptionalThing : bool option
mutable AnotherOptionalThing : int option
mutable YetAnotherOptionalThing : string option
}
member this.Assemble (positionals : string list) : Result<LoadsOfTypesNoPositionals, string list> =
@@ -337,10 +337,10 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed DatesAndTimes.
type private DatesAndTimes_InProgress =
{
Plain : TimeSpan option
Invariant : TimeSpan option
Exact : TimeSpan option
InvariantExact : TimeSpan option
mutable Plain : TimeSpan option
mutable Invariant : TimeSpan option
mutable Exact : TimeSpan option
mutable InvariantExact : TimeSpan option
}
member this.Assemble (positionals : string list) : Result<DatesAndTimes, string list> =
@@ -388,8 +388,8 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ChildRecord.
type private ChildRecord_InProgress =
{
Thing1 : System.Int32 option
Thing2 : System.String option
mutable Thing1 : System.Int32 option
mutable Thing2 : System.String option
}
member this.Assemble (positionals : string list) : Result<ChildRecord, string list> =
@@ -421,8 +421,8 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ParentRecord.
type private ParentRecord_InProgress =
{
Child : ChildRecord_InProgress
AndAnother : System.Boolean option
mutable Child : ChildRecord_InProgress
mutable AndAnother : System.Boolean option
}
member this.Assemble (positionals : string list) : Result<ParentRecord, string list> =
@@ -454,7 +454,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ChildRecordWithPositional.
type private ChildRecordWithPositional_InProgress =
{
Thing1 : System.Int32 option
mutable Thing1 : System.Int32 option
}
member this.Assemble (positionals : string list) : Result<ChildRecordWithPositional, string list> =
@@ -482,8 +482,8 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ParentRecordChildPos.
type private ParentRecordChildPos_InProgress =
{
Child : ChildRecordWithPositional_InProgress
AndAnother : System.Boolean option
mutable Child : ChildRecordWithPositional_InProgress
mutable AndAnother : System.Boolean option
}
member this.Assemble (positionals : string list) : Result<ParentRecordChildPos, string list> =
@@ -515,7 +515,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ParentRecordSelfPos.
type private ParentRecordSelfPos_InProgress =
{
Child : ChildRecord_InProgress
mutable Child : ChildRecord_InProgress
}
member this.Assemble (positionals : string list) : Result<ParentRecordSelfPos, string list> =
@@ -562,7 +562,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ContainsBoolEnvVar.
type private ContainsBoolEnvVar_InProgress =
{
BoolVar : bool option
mutable BoolVar : bool option
}
member this.Assemble (positionals : string list) : Result<ContainsBoolEnvVar, string list> =
@@ -584,7 +584,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed WithFlagDu.
type private WithFlagDu_InProgress =
{
DryRun : DryRunMode option
mutable DryRun : DryRunMode option
}
member this.Assemble (positionals : string list) : Result<WithFlagDu, string list> =
@@ -608,7 +608,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ContainsFlagEnvVar.
type private ContainsFlagEnvVar_InProgress =
{
DryRun : DryRunMode option
mutable DryRun : DryRunMode option
}
member this.Assemble (positionals : string list) : Result<ContainsFlagEnvVar, string list> =
@@ -630,7 +630,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ContainsFlagDefaultValue.
type private ContainsFlagDefaultValue_InProgress =
{
DryRun : DryRunMode option
mutable DryRun : DryRunMode option
}
member this.Assemble (positionals : string list) : Result<ContainsFlagDefaultValue, string list> =
@@ -652,8 +652,8 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed ManyLongForms.
type private ManyLongForms_InProgress =
{
DoTheThing : System.String option
SomeFlag : System.Boolean option
mutable DoTheThing : System.String option
mutable SomeFlag : System.Boolean option
}
member this.Assemble (positionals : string list) : Result<ManyLongForms, string list> =
@@ -685,7 +685,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed FlagsIntoPositionalArgs.
type private FlagsIntoPositionalArgs_InProgress =
{
A : System.String option
mutable A : System.String option
}
member this.Assemble (positionals : string list) : Result<FlagsIntoPositionalArgs, string list> =
@@ -713,7 +713,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed FlagsIntoPositionalArgsChoice.
type private FlagsIntoPositionalArgsChoice_InProgress =
{
A : System.String option
mutable A : System.String option
}
member this.Assemble (positionals : string list) : Result<FlagsIntoPositionalArgsChoice, string list> =
@@ -741,7 +741,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed FlagsIntoPositionalArgsInt.
type private FlagsIntoPositionalArgsInt_InProgress =
{
A : System.String option
mutable A : System.String option
}
member this.Assemble (positionals : string list) : Result<FlagsIntoPositionalArgsInt, string list> =
@@ -769,7 +769,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed FlagsIntoPositionalArgsIntChoice.
type private FlagsIntoPositionalArgsIntChoice_InProgress =
{
A : System.String option
mutable A : System.String option
}
member this.Assemble (positionals : string list) : Result<FlagsIntoPositionalArgsIntChoice, string list> =
@@ -797,7 +797,7 @@ module private ArgParseHelpers_ConsumePlugin =
/// A partially-parsed FlagsIntoPositionalArgs'.
type private FlagsIntoPositionalArgs'_InProgress =
{
A : System.String option
mutable A : System.String option
}
member this.Assemble (positionals : string list) : Result<FlagsIntoPositionalArgs', string list> =

5
WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs
View File

@@ -26,6 +26,11 @@ type ArgParserAttribute (isExtensionMethod : bool) =
/// an argument which looks like a flag but which we don't recognise.)
/// We will still interpret `--help` as requesting help, unless it comes after
/// a standalone `--` separator.
///
/// If the type of the PositionalArgs field is `Choice<'a, 'a>`, then we will
/// tell you whether each arg came before or after a standalone `--` separator.
/// For example, `MyApp foo bar -- baz` with PositionalArgs of `Choice<string, string>`
/// would yield `Choice1Of2 foo, Choice1Of2 bar, Choice2Of2 baz`.
type PositionalArgsAttribute (includeFlagLike : bool) =
inherit Attribute ()

137
WoofWare.Myriad.Plugins/ArgParserGenerator.fs
View File

@@ -7,82 +7,6 @@ open Fantomas.FCS.Text.Range
open TypeEquality
open WoofWare.Whippet.Fantomas
type internal ArgParserOutputSpec =
{
ExtensionMethods : bool
}
type internal FlagDu =
{
Name : Ident
Case1Name : Ident
Case2Name : Ident
/// Hopefully this is simply the const bool True or False, but it might e.g. be a literal
Case1Arg : SynExpr
/// Hopefully this is simply the const bool True or False, but it might e.g. be a literal
Case2Arg : SynExpr
}
static member FromBoolean (flagDu : FlagDu) (value : SynExpr) =
SynExpr.ifThenElse
(SynExpr.equals value flagDu.Case1Arg)
(SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ])
(SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ])
/// The default value of an argument which admits default values can be pulled from different sources.
/// This defines which source a particular default value comes from.
type private ArgumentDefaultSpec =
/// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever).
| EnvironmentVariable of name : SynExpr
/// From calling the static member `{typeWeParseInto}.Default{name}()`
/// For example, if `type MyArgs = { Thing : Choice<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
[<RequireQualifiedAccess>]
type private ChoicePositional =
| Normal of includeFlagLike : SynExpr option
@@ -114,14 +38,14 @@ type private ParseTree<'hasPositional> =
/// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in
/// the branch (e.g. each record field name),
/// and composes them into a `SynExpr` (e.g. the record-typed object).
| Branch of
| DescendRecord of
fields : (Ident * ParseTree<HasNoPositional>) list *
assemble : (Map<string, SynExpr> -> SynExpr) *
Teq<'hasPositional, HasNoPositional>
/// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in
/// the branch (e.g. each record field name),
/// and composes them into a `SynExpr` (e.g. the record-typed object).
| BranchPos of
| DescendRecordPos of
posField : Ident *
fields : ParseTree<HasPositional> *
(Ident * ParseTree<HasNoPositional>) list *
@@ -184,63 +108,6 @@ module private ParseTree =
go None ([], None) subs
let rec accumulatorsNonPos (tree : ParseTree<HasNoPositional>) : ParseFunctionNonPositional list =
match tree with
| ParseTree.PositionalLeaf (_, teq) -> exFalso teq
| ParseTree.BranchPos (_, _, _, _, teq) -> exFalso teq
| ParseTree.NonPositionalLeaf (pf, _) -> [ pf ]
| ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos)
/// Returns the positional arg separately.
let rec accumulatorsPos
(tree : ParseTree<HasPositional>)
: ParseFunctionNonPositional list * ParseFunctionPositional
=
match tree with
| ParseTree.PositionalLeaf (pf, _) -> [], pf
| ParseTree.NonPositionalLeaf (_, teq) -> exFalso' teq
| ParseTree.Branch (_, _, teq) -> exFalso' teq
| ParseTree.BranchPos (_, tree, trees, _, _) ->
let nonPos = trees |> List.collect (snd >> accumulatorsNonPos)
let nonPos2, pos = accumulatorsPos tree
nonPos @ nonPos2, pos
/// Collect all the ParseFunctions which are necessary to define variables, throwing away
/// all information relevant to composing the resulting variables into records.
/// Returns the list of non-positional parsers, and any positional parser that exists.
let accumulators<'a> (tree : ParseTree<'a>) : ParseFunctionNonPositional list * ParseFunctionPositional option =
// Sad duplication of some code here, but it was the easiest way to make it type-safe :(
match tree with
| ParseTree.PositionalLeaf (pf, _) -> [], Some pf
| ParseTree.NonPositionalLeaf (pf, _) -> [ pf ], None
| ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) |> (fun i -> i, None)
| ParseTree.BranchPos (_, tree, trees, _, _) ->
let nonPos = trees |> List.collect (snd >> accumulatorsNonPos)
let nonPos2, pos = accumulatorsPos tree
nonPos @ nonPos2, Some pos
|> fun (nonPos, pos) ->
let duplicateArgs =
// This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings.
Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm)
|> Seq.concat
|> Seq.choose (fun expr ->
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, _, _), _) -> Some s
| _ -> None
)
|> List.ofSeq
|> List.groupBy id
|> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None)
match duplicateArgs with
| [] -> nonPos, pos
| dups ->
let dups = dups |> String.concat " "
failwith $"Duplicate args detected! %s{dups}"
/// Build the return value.
let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr =
match tree with

848
WoofWare.Myriad.Plugins/ShibaGenerator.fs
View File

File diff suppressed because it is too large Load Diff

4
WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
View File

@@ -22,7 +22,7 @@
<ItemGroup>
<PackageReference Include="Myriad.Core" Version="0.8.3" />
<PackageReference Include="TypeEquality" Version="0.3.0" />
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.4.1" />
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.5.1" />
<!-- the lowest version allowed by Myriad.Core -->
<PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
</ItemGroup>
@@ -40,8 +40,8 @@
<Compile Include="JsonParseGenerator.fs"/>
<Compile Include="HttpClientGenerator.fs"/>
<Compile Include="CataGenerator.fs" />
<None Include="ArgParserGenerator.fs" />
<Compile Include="ShibaGenerator.fs" />
<None Include="ArgParserGenerator.fs" />
<Compile Include="Swagger.fs" />
<Compile Include="SwaggerClientGenerator.fs" />
<None Include="ApacheLicence.txt" />