Allow consuming *all* args as positionals, not just ones which look like --foo (#255)

* Bump Microsoft.NET.Test.Sdk from 17.11.0 to 17.11.1

Bumps [Microsoft.NET.Test.Sdk](https://github.com/microsoft/vstest) from 17.11.0 to 17.11.1.
- [Release notes](https://github.com/microsoft/vstest/releases)
- [Changelog](https://github.com/microsoft/vstest/blob/main/docs/releases.md)
- [Commits](https://github.com/microsoft/vstest/compare/v17.11.0...v17.11.1)

---
updated-dependencies:
- dependency-name: Microsoft.NET.Test.Sdk
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Bump fantomas from 6.3.11 to 6.3.12

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.11 to 6.3.12.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.11...v6.3.12)

---
updated-dependencies:
- dependency-name: fantomas
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>

.config/dotnet-tools.json

@@ -3,7 +3,7 @@
   "isRoot": true,
   "tools": {
     "fantomas": {
-      "version": "6.3.11",
+      "version": "6.3.12",
       "commands": [
         "fantomas"
       ]

.github/workflows/dotnet.yaml

@@ -241,7 +241,7 @@ jobs:
           name: nuget-package-attribute
           path: packed
       - name: Attest Build Provenance
-        uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
+        uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
         with:
           subject-path: "packed/*.nupkg"
 
@@ -260,7 +260,7 @@ jobs:
           name: nuget-package-plugin
           path: packed
       - name: Attest Build Provenance
-        uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
+        uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
         with:
           subject-path: "packed/*.nupkg"
 

ConsumePlugin/Args.fs

@@ -111,7 +111,7 @@ type ChildRecordWithPositional =
     {
         Thing1 : int
         [<PositionalArgs>]
-        Thing2 : string list
+        Thing2 : Uri list
     }
 
 [<ArgParser true>]
@@ -135,3 +135,79 @@ type ChoicePositionals =
         [<PositionalArgs>]
         Args : Choice<string, string> list
     }
+
+[<ArgParser true>]
+type ContainsBoolEnvVar =
+    {
+        [<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
+        BoolVar : Choice<bool, bool>
+    }
+
+[<RequireQualifiedAccess>]
+module Consts =
+    [<Literal>]
+    let FALSE = false
+
+    [<Literal>]
+    let TRUE = true
+
+type DryRunMode =
+    | [<ArgumentFlag(Consts.FALSE)>] Wet
+    | [<ArgumentFlag true>] Dry
+
+[<ArgParser true>]
+type WithFlagDu =
+    {
+        DryRun : DryRunMode
+    }
+
+[<ArgParser true>]
+type ContainsFlagEnvVar =
+    {
+        // This phrasing is odd, but it's for a test. Nobody's really going to have `--dry-run`
+        // controlled by an env var!
+        [<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
+        DryRun : Choice<DryRunMode, DryRunMode>
+    }
+
+[<ArgParser true>]
+type ContainsFlagDefaultValue =
+    {
+        [<ArgumentDefaultFunction>]
+        DryRun : Choice<DryRunMode, DryRunMode>
+    }
+
+    static member DefaultDryRun () = DryRunMode.Wet
+
+[<ArgParser true>]
+type ManyLongForms =
+    {
+        [<ArgumentLongForm "do-something-else">]
+        [<ArgumentLongForm "anotherarg">]
+        DoTheThing : string
+
+        [<ArgumentLongForm "turn-it-on">]
+        [<ArgumentLongForm "dont-turn-it-off">]
+        SomeFlag : bool
+    }
+
+[<RequireQualifiedAccess>]
+type private IrrelevantDu =
+    | Foo
+    | Bar
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgs =
+    {
+        A : string
+        [<PositionalArgs true>]
+        GrabEverything : string list
+    }
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgs' =
+    {
+        A : string
+        [<PositionalArgs false>]
+        DontGrabEverything : string list
+    }

WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs

@@ -19,9 +19,22 @@ type ArgParserAttribute (isExtensionMethod : bool) =
 
 /// Attribute indicating that this field shall accumulate all unmatched args,
 /// as well as any that appear after a bare `--`.
-type PositionalArgsAttribute () =
+///
+/// Set `includeFlagLike = true` to include args that begin `--` in the
+/// positional args.
+/// (By default, `includeFlagLike = false` and we throw when encountering
+/// 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.
+type PositionalArgsAttribute (includeFlagLike : bool) =
     inherit Attribute ()
 
+    /// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor.
+    static member DefaultIncludeFlagLike = false
+
+    /// Shorthand for the "includeFlagLike = false" constructor; see documentation there for details.
+    new () = PositionalArgsAttribute PositionalArgsAttribute.DefaultIncludeFlagLike
+
 /// Attribute indicating that this field shall have a default value derived
 /// from calling an appropriately named static method on the type.
 ///
@@ -61,3 +74,24 @@ type ParseExactAttribute (format : string) =
 /// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.InvariantCulture).
 type InvariantCultureAttribute () =
     inherit Attribute ()
+
+/// Attribute placed on a field of a two-case no-data discriminated union, indicating that this is "basically a bool".
+/// For example: `type DryRun = | [<ArgumentFlag true>] Dry | [<ArgumentFlag false>] Wet`
+/// A record with `{ DryRun : DryRun }` will then be parsed like `{ DryRun : bool }` (so the user supplies `--dry-run`),
+/// but that you get this strongly-typed value directly in the code (so you `match args.DryRun with | DryRun.Dry ...`).
+///
+/// You must put this attribute on both cases of the discriminated union, with opposite values in each case.
+type ArgumentFlagAttribute (flagValue : bool) =
+    inherit Attribute ()
+
+/// Attribute placed on a field of a record to specify a different long form from the default. If you place this
+/// attribute, you won't get the default: ArgFoo would normally be expressed as `--arg-foo`, but if you instead
+/// say `[<ArgumentLongForm "thingy-blah">]` or `[<ArgumentLongForm "thingy">]`, you instead use `--thingy-blah`
+/// or `--thingy` respectively.
+///
+/// You can place this argument multiple times.
+///
+/// Omit the initial `--` that you expect the user to type.
+[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
+type ArgumentLongForm (s : string) =
+    inherit Attribute ()

WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt

@@ -7,8 +7,12 @@ WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute inherit Syst
 WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.ArgumentFlagAttribute inherit System.Attribute
+WoofWare.Myriad.Plugins.ArgumentFlagAttribute..ctor [constructor]: bool
 WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute..ctor [constructor]: string
+WoofWare.Myriad.Plugins.ArgumentLongForm inherit System.Attribute
+WoofWare.Myriad.Plugins.ArgumentLongForm..ctor [constructor]: string
 WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute
@@ -36,7 +40,10 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [sta
 WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute
+WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: bool
 WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.PositionalArgsAttribute.DefaultIncludeFlagLike [static property]: [read-only] bool
+WoofWare.Myriad.Plugins.PositionalArgsAttribute.get_DefaultIncludeFlagLike [static method]: unit -> bool
 WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.RestEase inherit obj

WoofWare.Myriad.Plugins.Attributes/Test/WoofWare.Myriad.Plugins.Attributes.Test.fsproj

@@ -18,7 +18,7 @@
 
     <ItemGroup>
         <PackageReference Include="ApiSurface" Version="4.1.5" />
-        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
+        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
         <PackageReference Include="NUnit" Version="4.2.2"/>
         <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
     </ItemGroup>

WoofWare.Myriad.Plugins.Attributes/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "3.2",
+  "version": "3.5",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],
@@ -12,4 +12,4 @@
     "./",
     ":^Test"
   ]
-}
+}

WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs

@@ -367,18 +367,19 @@ Required argument '--exact' received no value"""
         let parsed =
             ParentRecordChildPos.parse'
                 getEnvVar
-                [ "--and-another=true" ; "--thing1=9" ; "--thing2=some" ; "--thing2=thing" ]
+                [
+                    "--and-another=true"
+                    "--thing1=9"
+                    "--thing2=https://example.com"
+                    "--thing2=http://example.com"
+                ]
 
-        parsed
-        |> shouldEqual
-            {
-                Child =
-                    {
-                        Thing1 = 9
-                        Thing2 = [ "some" ; "thing" ]
-                    }
-                AndAnother = true
-            }
+        parsed.AndAnother |> shouldEqual true
+        parsed.Child.Thing1 |> shouldEqual 9
+
+        parsed.Child.Thing2
+        |> List.map (fun (x : Uri) -> x.ToString ())
+        |> shouldEqual [ "https://example.com/" ; "http://example.com/" ]
 
     [<Test>]
     let ``Can consume stacked record, child has no positionals, parent has positionals`` () =
@@ -431,3 +432,234 @@ Required argument '--exact' received no value"""
             {
                 Args = [ Choice1Of2 "a" ; Choice1Of2 "b" ; Choice2Of2 "--c" ; Choice2Of2 "--help" ]
             }
+
+    let boolCases =
+        [
+            "1", true
+            "0", false
+            "true", true
+            "false", false
+            "TRUE", true
+            "FALSE", false
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof (boolCases))>]
+    let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
+        let getEnvVar (s : string) =
+            s |> shouldEqual "CONSUMEPLUGIN_THINGS"
+            envValue
+
+        ContainsBoolEnvVar.parse' getEnvVar []
+        |> shouldEqual
+            {
+                BoolVar = Choice2Of2 boolValue
+            }
+
+    [<Test>]
+    let ``Bools can be treated with arity 0`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsBoolEnvVar.parse' getEnvVar [ "--bool-var" ]
+        |> shouldEqual
+            {
+                BoolVar = Choice1Of2 true
+            }
+
+    [<TestCaseSource(nameof boolCases)>]
+    let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
+        let getEnvVar (s : string) =
+            s |> shouldEqual "CONSUMEPLUGIN_THINGS"
+            envValue
+
+        let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
+
+        ContainsFlagEnvVar.parse' getEnvVar []
+        |> shouldEqual
+            {
+                DryRun = Choice2Of2 boolValue
+            }
+
+    let dryRunData =
+        [
+            [ "--dry-run" ], DryRunMode.Dry
+            [ "--dry-run" ; "true" ], DryRunMode.Dry
+            [ "--dry-run=true" ], DryRunMode.Dry
+            [ "--dry-run" ; "True" ], DryRunMode.Dry
+            [ "--dry-run=True" ], DryRunMode.Dry
+            [ "--dry-run" ; "false" ], DryRunMode.Wet
+            [ "--dry-run=false" ], DryRunMode.Wet
+            [ "--dry-run" ; "False" ], DryRunMode.Wet
+            [ "--dry-run=False" ], DryRunMode.Wet
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof dryRunData)>]
+    let ``Flag DUs can be parsed`` (args : string list, expected : DryRunMode) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagEnvVar.parse' getEnvVar args
+        |> shouldEqual
+            {
+                DryRun = Choice1Of2 expected
+            }
+
+    [<TestCaseSource(nameof dryRunData)>]
+    let ``Flag DUs can be parsed, ArgumentDefaultFunction`` (args : string list, expected : DryRunMode) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagDefaultValue.parse' getEnvVar args
+        |> shouldEqual
+            {
+                DryRun = Choice1Of2 expected
+            }
+
+    [<Test>]
+    let ``Flag DUs can be given a default value`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagDefaultValue.parse' getEnvVar []
+        |> shouldEqual
+            {
+                DryRun = Choice2Of2 DryRunMode.Wet
+            }
+
+    [<Test>]
+    let ``Help text for flag DU`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                ContainsFlagDefaultValue.parse' getEnvVar [ "--help" ]
+                |> ignore<ContainsFlagDefaultValue>
+            )
+
+        exc.Message
+        |> shouldEqual
+            """Help text requested.
+--dry-run  bool (default value: false)"""
+
+    [<Test>]
+    let ``Help text for flag DU, non default`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () -> WithFlagDu.parse' getEnvVar [ "--help" ] |> ignore<WithFlagDu>)
+
+        exc.Message
+        |> shouldEqual
+            """Help text requested.
+--dry-run  bool"""
+
+    let longFormCases =
+        let doTheThing =
+            [
+                [ "--do-something-else=foo" ]
+                [ "--anotherarg=foo" ]
+                [ "--do-something-else" ; "foo" ]
+                [ "--anotherarg" ; "foo" ]
+            ]
+
+        let someFlag =
+            [
+                [ "--turn-it-on" ], true
+                [ "--dont-turn-it-off" ], true
+                [ "--turn-it-on=true" ], true
+                [ "--dont-turn-it-off=true" ], true
+                [ "--turn-it-on=false" ], false
+                [ "--dont-turn-it-off=false" ], false
+                [ "--turn-it-on" ; "true" ], true
+                [ "--dont-turn-it-off" ; "true" ], true
+                [ "--turn-it-on" ; "false" ], false
+                [ "--dont-turn-it-off" ; "false" ], false
+            ]
+
+        List.allPairs doTheThing someFlag
+        |> List.map (fun (doTheThing, (someFlag, someFlagResult)) ->
+            let args = doTheThing @ someFlag
+
+            let expected =
+                {
+                    DoTheThing = "foo"
+                    SomeFlag = someFlagResult
+                }
+
+            args, expected
+        )
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof longFormCases)>]
+    let ``Long-form args`` (args : string list, expected : ManyLongForms) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ManyLongForms.parse' getEnvVar args |> shouldEqual expected
+
+    [<Test>]
+    let ``Long-form args can't be referred to by their original name`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                ManyLongForms.parse' getEnvVar [ "--do-the-thing=foo" ] |> ignore<ManyLongForms>
+            )
+
+        exc.Message
+        |> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
+
+    [<Test>]
+    let ``Long-form args help text`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () -> ManyLongForms.parse' getEnvVar [ "--help" ] |> ignore<ManyLongForms>)
+
+        exc.Message
+        |> shouldEqual
+            """Help text requested.
+--do-something-else / --anotherarg  string
+--turn-it-on / --dont-turn-it-off  bool"""
+
+    [<Test>]
+    let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
+        |> shouldEqual
+            {
+                A = "foo"
+                GrabEverything = [ "--b=false" ; "--c=hi" ; "--help" ]
+            }
+
+        // Users might consider this eccentric!
+        // But we're only a simple arg parser; we don't look around to see whether this is "almost"
+        // a valid parse.
+        FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
+        |> shouldEqual
+            {
+                A = "--b=false"
+                GrabEverything = [ "--c=hi" ; "--help" ]
+            }
+
+    [<Test>]
+    let ``Can refuse to collect non-help args`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
+                |> ignore<FlagsIntoPositionalArgs'>
+            )
+
+        exc.Message
+        |> shouldEqual """Unable to process argument --b=false as key --b and value false"""
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
+                |> ignore<FlagsIntoPositionalArgs'>
+            )
+
+        // Again perhaps eccentric!
+        // Again, we don't try to detect that the user has missed out the desired argument to `--a`.
+        exc.Message
+        |> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""

WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj

@@ -42,7 +42,7 @@
     <PackageReference Include="ApiSurface" Version="4.1.5"/>
     <PackageReference Include="FsCheck" Version="2.16.6"/>
     <PackageReference Include="FsUnit" Version="6.0.0"/>
-    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
+    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
     <PackageReference Include="NUnit" Version="4.2.2"/>
     <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
   </ItemGroup>

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -12,6 +12,23 @@ 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 =
@@ -20,6 +37,7 @@ type private ArgumentDefaultSpec =
     /// 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> =
@@ -32,7 +50,18 @@ type private ParseFunction<'acc> =
     {
         FieldName : Ident
         TargetVariable : Ident
-        ArgForm : string
+        /// 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
@@ -45,10 +74,19 @@ type private ParseFunction<'acc> =
         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
-    | Choice
+    | Normal of includeFlagLike : SynExpr option
+    | Choice of includeFlagLike : SynExpr option
 
 type private ParseFunctionPositional = ParseFunction<ChoicePositional>
 type private ParseFunctionNonPositional = ParseFunction<Accumulation<ArgumentDefaultSpec>>
@@ -185,7 +223,15 @@ module private ParseTree =
 
         |> 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)
 
@@ -226,7 +272,6 @@ module internal ArgParserGenerator =
     /// Convert e.g. "Foo" into "--foo".
     let argify (ident : Ident) : string =
         let result = StringBuilder ()
-        result.Append "-" |> ignore<StringBuilder>
 
         for c in ident.idText do
             if Char.IsUpper c then
@@ -234,7 +279,18 @@ module internal ArgParserGenerator =
             else
                 result.Append c |> ignore<StringBuilder>
 
-        result.ToString ()
+        result.ToString().TrimStart '-'
+
+    let private identifyAsFlag (flagDus : FlagDu list) (ty : SynType) : FlagDu option =
+        match ty with
+        | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
+            flagDus
+            |> List.tryPick (fun du ->
+                let duName = du.Name.idText
+                let ident = List.last(ident).idText
+                if duName = ident then Some du else None
+            )
+        | _ -> None
 
     /// Builds a function or lambda of one string argument, which returns a `ty` (as modified by the `Accumulation`;
     /// for example, maybe it returns a `ty option` or a `ty list`).
@@ -242,6 +298,7 @@ module internal ArgParserGenerator =
     /// is the list element.
     let rec private createParseFunction<'choice>
         (choice : ArgumentDefaultSpec option -> 'choice)
+        (flagDus : FlagDu list)
         (fieldName : Ident)
         (attrs : SynAttribute list)
         (ty : SynType)
@@ -257,6 +314,12 @@ module internal ArgParserGenerator =
                     (SynExpr.createIdent "x")),
             Accumulation.Required,
             ty
+        | Uri ->
+            SynExpr.createLambda
+                "x"
+                (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Uri" ]) (SynExpr.createIdent "x")),
+            Accumulation.Required,
+            ty
         | TimeSpan ->
             let parseExact =
                 attrs
@@ -328,7 +391,8 @@ module internal ArgParserGenerator =
             Accumulation.Required,
             ty
         | OptionType eltTy ->
-            let parseElt, acc, childTy = createParseFunction choice fieldName attrs eltTy
+            let parseElt, acc, childTy =
+                createParseFunction choice flagDus fieldName attrs eltTy
 
             match acc with
             | Accumulation.Optional ->
@@ -347,7 +411,7 @@ module internal ArgParserGenerator =
                     failwith
                         $"ArgParser was unable to prove types %O{elt1} and %O{elt2} to be equal in a Choice. We require them to be equal."
 
-                let parseElt, acc, childTy = createParseFunction choice fieldName attrs elt1
+                let parseElt, acc, childTy = createParseFunction choice flagDus fieldName attrs elt1
 
                 match acc with
                 | Accumulation.Optional ->
@@ -385,6 +449,7 @@ module internal ArgParserGenerator =
                         | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ]
                         | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ]
                         | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] ->
+
                             ArgumentDefaultSpec.EnvironmentVariable attr.ArgExpr |> Some
                         | _ -> None
                     )
@@ -404,13 +469,26 @@ module internal ArgParserGenerator =
                 failwith
                     $"ArgParser requires Choice to be of the form Choice<'a, 'a>; that is, two arguments, both the same. For field %s{fieldName.idText}, got: %s{elts}"
         | ListType eltTy ->
-            let parseElt, acc, childTy = createParseFunction choice fieldName attrs eltTy
+            let parseElt, acc, childTy =
+                createParseFunction choice flagDus fieldName attrs eltTy
 
             parseElt, Accumulation.List acc, childTy
-        | _ -> failwith $"Could not decide how to parse arguments for field %s{fieldName.idText} of type %O{ty}"
+        | ty ->
+            match identifyAsFlag flagDus ty with
+            | None -> failwith $"Could not decide how to parse arguments for field %s{fieldName.idText} of type %O{ty}"
+            | Some flagDu ->
+                // Parse as a bool, and then do the `if-then` dance.
+                let parser =
+                    SynExpr.createIdent "x"
+                    |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ])
+                    |> FlagDu.FromBoolean flagDu
+                    |> SynExpr.createLambda "x"
+
+                parser, Accumulation.Required, ty
 
     let rec private toParseSpec
         (counter : int)
+        (flagDus : FlagDu list)
         (ambientRecords : RecordType list)
         (finalRecord : RecordType)
         : ParseTreeCrate * int
@@ -428,11 +506,14 @@ module internal ArgParserGenerator =
 
                 let positionalArgAttr =
                     attrs
-                    |> List.tryFind (fun a ->
+                    |> List.tryPick (fun a ->
                         match (List.last a.TypeName.LongIdent).idText with
                         | "PositionalArgsAttribute"
-                        | "PositionalArgs" -> true
-                        | _ -> false
+                        | "PositionalArgs" ->
+                            match a.ArgExpr with
+                            | SynExpr.Const (SynConst.Unit, _) -> Some None
+                            | a -> Some (Some a)
+                        | _ -> None
                     )
 
                 let parseExactModifier =
@@ -473,6 +554,20 @@ module internal ArgParserGenerator =
                     | None -> failwith "expected args field to have a name, but it did not"
                     | Some i -> i
 
+                let longForms =
+                    attrs
+                    |> List.choose (fun attr ->
+                        match attr.TypeName with
+                        | SynLongIdent.SynLongIdent (ident, _, _) ->
+                            if (List.last ident).idText = "ArgumentLongForm" then
+                                Some attr.ArgExpr
+                            else
+                                None
+                    )
+                    |> function
+                        | [] -> List.singleton (SynExpr.CreateConst (argify ident))
+                        | l -> List.ofSeq l
+
                 let ambientRecordMatch =
                     match fieldType with
                     | SynType.LongIdent (SynLongIdent.SynLongIdent (id, _, _)) ->
@@ -483,12 +578,12 @@ module internal ArgParserGenerator =
                 match ambientRecordMatch with
                 | Some ambient ->
                     // This field has a type we need to obtain from parsing another record.
-                    let spec, counter = toParseSpec counter ambientRecords ambient
+                    let spec, counter = toParseSpec counter flagDus ambientRecords ambient
                     counter, (ident, spec) :: acc
                 | None ->
 
                 match positionalArgAttr with
-                | Some _ ->
+                | Some includeFlagLike ->
                     let getChoice (spec : ArgumentDefaultSpec option) : unit =
                         match spec with
                         | Some _ ->
@@ -497,7 +592,13 @@ module internal ArgParserGenerator =
                         | None -> ()
 
                     let parser, accumulation, parseTy =
-                        createParseFunction<unit> getChoice ident attrs fieldType
+                        createParseFunction<unit> getChoice flagDus ident attrs fieldType
+
+                    let isBoolLike =
+                        match parseTy with
+                        | PrimitiveType ident when ident |> List.map _.idText = [ "System" ; "Boolean" ] ->
+                            Some (Choice2Of2 ())
+                        | parseTy -> identifyAsFlag flagDus parseTy |> Option.map Choice1Of2
 
                     match accumulation with
                     | Accumulation.List (Accumulation.List _) ->
@@ -509,10 +610,11 @@ module internal ArgParserGenerator =
                             FieldName = ident
                             Parser = parser
                             TargetVariable = Ident.create $"arg_%i{counter}"
-                            Accumulation = ChoicePositional.Choice
+                            Accumulation = ChoicePositional.Choice includeFlagLike
                             TargetType = parseTy
-                            ArgForm = argify ident
+                            ArgForm = longForms
                             Help = helpText
+                            BoolCases = isBoolLike
                         }
                         |> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
                     | Accumulation.List Accumulation.Required ->
@@ -520,10 +622,11 @@ module internal ArgParserGenerator =
                             FieldName = ident
                             Parser = parser
                             TargetVariable = Ident.create $"arg_%i{counter}"
-                            Accumulation = ChoicePositional.Normal
+                            Accumulation = ChoicePositional.Normal includeFlagLike
                             TargetType = parseTy
-                            ArgForm = argify ident
+                            ArgForm = longForms
                             Help = helpText
+                            BoolCases = isBoolLike
                         }
                         |> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
                     | Accumulation.Choice _
@@ -540,7 +643,13 @@ module internal ArgParserGenerator =
                         | Some spec -> spec
 
                     let parser, accumulation, parseTy =
-                        createParseFunction getChoice ident attrs fieldType
+                        createParseFunction getChoice flagDus ident attrs fieldType
+
+                    let isBoolLike =
+                        match parseTy with
+                        | PrimitiveType ident when ident |> List.map _.idText = [ "System" ; "Boolean" ] ->
+                            Some (Choice2Of2 ())
+                        | parseTy -> identifyAsFlag flagDus parseTy |> Option.map Choice1Of2
 
                     {
                         FieldName = ident
@@ -548,8 +657,9 @@ module internal ArgParserGenerator =
                         TargetVariable = Ident.create $"arg_%i{counter}"
                         Accumulation = accumulation
                         TargetType = parseTy
-                        ArgForm = argify ident
+                        ArgForm = longForms
                         Help = helpText
+                        BoolCases = isBoolLike
                     }
                     |> fun t -> ParseTree.NonPositionalLeaf (t, Teq.refl)
                     |> ParseTreeCrate.make
@@ -575,7 +685,11 @@ module internal ArgParserGenerator =
         (args : ParseFunctionNonPositional list)
         : SynBinding
         =
-        let describeNonPositional (acc : Accumulation<ArgumentDefaultSpec>) : SynExpr =
+        let describeNonPositional
+            (acc : Accumulation<ArgumentDefaultSpec>)
+            (flagCases : Choice<FlagDu, unit> option)
+            : SynExpr
+            =
             match acc with
             | Accumulation.Required -> SynExpr.CreateConst ""
             | Accumulation.Optional -> SynExpr.CreateConst " (optional)"
@@ -590,18 +704,46 @@ module internal ArgParserGenerator =
                 )
                 |> SynExpr.paren
             | Accumulation.Choice (ArgumentDefaultSpec.FunctionCall var) ->
-                SynExpr.callMethod var.idText (SynExpr.createIdent' typeName)
+                match flagCases with
+                | None -> SynExpr.callMethod var.idText (SynExpr.createIdent' typeName)
+                | Some (Choice2Of2 ()) -> SynExpr.callMethod var.idText (SynExpr.createIdent' typeName)
+                | Some (Choice1Of2 flagDu) ->
+                    // Care required here. The return value from the Default call is not a bool,
+                    // but we should display it as such to the user!
+                    [
+                        SynMatchClause.create
+                            (SynPat.identWithArgs [ flagDu.Name ; flagDu.Case1Name ] (SynArgPats.create []))
+                            (SynExpr.ifThenElse
+                                (SynExpr.equals flagDu.Case1Arg (SynExpr.CreateConst true))
+                                (SynExpr.CreateConst "false")
+                                (SynExpr.CreateConst "true"))
+                        SynMatchClause.create
+                            (SynPat.identWithArgs [ flagDu.Name ; flagDu.Case2Name ] (SynArgPats.create []))
+                            (SynExpr.ifThenElse
+                                (SynExpr.equals flagDu.Case2Arg (SynExpr.CreateConst true))
+                                (SynExpr.CreateConst "false")
+                                (SynExpr.CreateConst "true"))
+                    ]
+                    |> SynExpr.createMatch (SynExpr.callMethod var.idText (SynExpr.createIdent' typeName))
                 |> SynExpr.pipeThroughFunction (
-                    SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst " (default value: %O)")
+                    SynExpr.createLambda "x" (SynExpr.callMethod "ToString" (SynExpr.createIdent "x"))
+                )
+                |> SynExpr.pipeThroughFunction (
+                    SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst " (default value: %s)")
                 )
                 |> SynExpr.paren
             | Accumulation.List _ -> SynExpr.CreateConst " (can be repeated)"
 
-        let describePositional _ =
+        let describePositional _ _ =
             SynExpr.CreateConst " (positional args) (can be repeated)"
 
-        let toPrintable (describe : 'a -> SynExpr) (arg : ParseFunction<'a>) : SynExpr =
-            let ty = arg.TargetType |> SynType.toHumanReadableString
+        /// We may sometimes lie about the type name, if e.g. this is a flag DU which we're pretending is a boolean.
+        /// So the `renderTypeName` takes the Accumulation which tells us whether we're lying.
+        let toPrintable (describe : 'a -> Choice<FlagDu, unit> option -> SynExpr) (arg : ParseFunction<'a>) : SynExpr =
+            let ty =
+                match arg.BoolCases with
+                | None -> SynType.toHumanReadableString arg.TargetType
+                | Some _ -> "bool"
 
             let helpText =
                 match arg.Help with
@@ -611,11 +753,10 @@ module internal ArgParserGenerator =
                     |> SynExpr.applyTo (SynExpr.paren helpText)
                     |> SynExpr.paren
 
-            let descriptor = describe arg.Accumulation
+            let descriptor = describe arg.Accumulation arg.BoolCases
 
-            let prefix = $"%s{arg.ArgForm}  %s{ty}"
-
-            SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst (prefix + "%s%s"))
+            SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst $"%%s  %s{ty}%%s%%s")
+            |> SynExpr.applyTo arg.HumanReadableArgForm
             |> SynExpr.applyTo descriptor
             |> SynExpr.applyTo helpText
             |> SynExpr.paren
@@ -651,10 +792,12 @@ module internal ArgParserGenerator =
                 | Accumulation.Optional ->
                     let multipleErrorMessage =
                         SynExpr.createIdent "sprintf"
-                        |> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %O and %O")
-                        |> SynExpr.applyTo (SynExpr.CreateConst arg.ArgForm)
-                        |> SynExpr.applyTo (SynExpr.createIdent "x")
-                        |> SynExpr.applyTo (SynExpr.createIdent "value")
+                        |> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s")
+                        |> SynExpr.applyTo arg.HumanReadableArgForm
+                        |> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren)
+                        |> SynExpr.applyTo (
+                            SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
+                        )
 
                     let performAssignment =
                         [
@@ -715,8 +858,9 @@ module internal ArgParserGenerator =
                     |> SynExpr.pipeThroughFunction pos.Parser
                     |> fun p ->
                         match pos.Accumulation with
-                        | ChoicePositional.Choice -> p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
-                        | ChoicePositional.Normal -> p
+                        | ChoicePositional.Choice _ ->
+                            p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
+                        | ChoicePositional.Normal _ -> p
                     |> SynExpr.pipeThroughFunction (
                         SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
                     )
@@ -728,17 +872,24 @@ module internal ArgParserGenerator =
 
         (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), posArg @ args)
         ||> List.fold (fun finalBranch (argForm, arg) ->
-            arg
-            |> SynExpr.ifThenElse
-                (SynExpr.applyFunction
-                    (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
-                    (SynExpr.tuple
-                        [
-                            SynExpr.createIdent "key"
-                            SynExpr.CreateConst argForm
-                            SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
-                        ]))
-                finalBranch
+            (finalBranch, argForm)
+            ||> List.fold (fun finalBranch argForm ->
+                arg
+                |> SynExpr.ifThenElse
+                    (SynExpr.applyFunction
+                        (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                        (SynExpr.tuple
+                            [
+                                SynExpr.createIdent "key"
+                                SynExpr.applyFunction
+                                    (SynExpr.applyFunction
+                                        (SynExpr.createIdent "sprintf")
+                                        (SynExpr.CreateConst "--%s"))
+                                    argForm
+                                SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                            ]))
+                    finalBranch
+            )
         )
         |> SynBinding.basic
             [ Ident.create "processKeyValue" ]
@@ -759,46 +910,61 @@ module internal ArgParserGenerator =
         )
 
     /// `let setFlagValue (key : string) : bool = ...`
-    let private setFlagValue (argParseErrors : Ident) (flags : ParseFunction<'a> list) : SynBinding =
+    /// The second member of the `flags` list tuple is the constant "true" with which we will interpret the
+    /// arity-0 `--foo`. So in the case of a boolean-typed field, this is `true`; in the case of a Flag-typed field,
+    /// this is `FlagType.WhicheverCaseHadTrue`.
+    let private setFlagValue (argParseErrors : Ident) (flags : (ParseFunction<'a> * SynExpr) list) : SynBinding =
         (SynExpr.CreateConst false, flags)
-        ||> List.fold (fun finalExpr flag ->
+        ||> List.fold (fun finalExpr (flag, trueCase) ->
             let multipleErrorMessage =
                 SynExpr.createIdent "sprintf"
                 |> SynExpr.applyTo (SynExpr.CreateConst "Flag '%s' was supplied multiple times")
-                |> SynExpr.applyTo (SynExpr.CreateConst flag.ArgForm)
+                |> SynExpr.applyTo flag.HumanReadableArgForm
 
-            [
-                SynMatchClause.create
-                    (SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
-                    // This is an error, but it's one we can gracefully report at the end.
-                    (SynExpr.sequential
-                        [
-                            multipleErrorMessage
-                            |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors))
+            let matchFlag =
+                [
+                    SynMatchClause.create
+                        (SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
+                        // This is an error, but it's one we can gracefully report at the end.
+                        (SynExpr.sequential
+                            [
+                                multipleErrorMessage
+                                |> SynExpr.pipeThroughFunction (
+                                    SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
+                                )
+                                SynExpr.CreateConst true
+                            ])
+
+                    SynMatchClause.create
+                        (SynPat.named "None")
+                        ([
+                            SynExpr.assign
+                                (SynLongIdent.createI flag.TargetVariable)
+                                (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase)
                             SynExpr.CreateConst true
-                        ])
+                         ]
+                         |> SynExpr.sequential)
+                ]
+                |> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
 
-                SynMatchClause.create
-                    (SynPat.named "None")
-                    ([
-                        SynExpr.assign
-                            (SynLongIdent.createI flag.TargetVariable)
-                            (SynExpr.applyFunction (SynExpr.createIdent "Some") (SynExpr.CreateConst true))
-                        SynExpr.CreateConst true
-                     ]
-                     |> SynExpr.sequential)
-            ]
-            |> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
-            |> SynExpr.ifThenElse
-                (SynExpr.applyFunction
-                    (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
-                    (SynExpr.tuple
-                        [
-                            SynExpr.createIdent "key"
-                            SynExpr.CreateConst flag.ArgForm
-                            SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
-                        ]))
-                finalExpr
+            (finalExpr, flag.ArgForm)
+            ||> List.fold (fun finalExpr argForm ->
+                SynExpr.ifThenElse
+                    (SynExpr.applyFunction
+                        (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                        (SynExpr.tuple
+                            [
+                                SynExpr.createIdent "key"
+                                SynExpr.applyFunction
+                                    (SynExpr.applyFunction
+                                        (SynExpr.createIdent "sprintf")
+                                        (SynExpr.CreateConst "--%s"))
+                                    argForm
+                                SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                            ]))
+                    finalExpr
+                    matchFlag
+            )
         )
         |> SynBinding.basic [ Ident.create "setFlagValue" ] [ SynPat.annotateType SynType.string (SynPat.named "key") ]
         |> SynBinding.withReturnAnnotation (SynType.named "bool")
@@ -838,6 +1004,50 @@ module internal ArgParserGenerator =
             |> SynExpr.applyTo (SynExpr.createIdent "key")
             |> SynExpr.applyTo (SynExpr.createIdent "value")
 
+        let processAsPositional =
+            SynExpr.sequential
+                [
+                    SynExpr.createIdent "arg"
+                    |> SynExpr.pipeThroughFunction leftoverArgParser
+                    |> fun p ->
+                        match leftoverArgAcc with
+                        | ChoicePositional.Normal _ -> p
+                        | ChoicePositional.Choice _ ->
+                            p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
+                    |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
+
+                    recurseKey
+                ]
+
+        let notMatched =
+            let posAttr =
+                match leftoverArgAcc with
+                | ChoicePositional.Choice a
+                | ChoicePositional.Normal a -> a
+
+            let handleFailure =
+                [
+                    SynMatchClause.create (SynPat.named "None") fail
+
+                    SynMatchClause.create
+                        (SynPat.nameWithArgs "Some" [ SynPat.named "msg" ])
+                        (SynExpr.sequential
+                            [
+                                SynExpr.createIdent "sprintf"
+                                |> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)")
+                                |> SynExpr.applyTo (SynExpr.createIdent "msg")
+                                |> SynExpr.applyTo (SynExpr.createIdent "arg")
+                                |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc))
+
+                                recurseKey
+                            ])
+                ]
+                |> SynExpr.createMatch (SynExpr.createIdent "x")
+
+            match posAttr with
+            | None -> handleFailure
+            | Some posAttr -> SynExpr.ifThenElse posAttr handleFailure processAsPositional
+
         let argStartsWithDashes =
             SynExpr.createIdent "arg"
             |> SynExpr.callMethodArg
@@ -851,19 +1061,7 @@ module internal ArgParserGenerator =
         let processKey =
             SynExpr.ifThenElse
                 argStartsWithDashes
-                (SynExpr.sequential
-                    [
-                        SynExpr.createIdent "arg"
-                        |> SynExpr.pipeThroughFunction leftoverArgParser
-                        |> fun p ->
-                            match leftoverArgAcc with
-                            | ChoicePositional.Normal -> p
-                            | ChoicePositional.Choice ->
-                                p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
-                        |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
-
-                        recurseKey
-                    ])
+                processAsPositional
                 (SynExpr.ifThenElse
                     (SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help"))
                     (SynExpr.createLet
@@ -899,23 +1097,9 @@ module internal ArgParserGenerator =
                                     [
                                         SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey
 
-                                        SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "None" ]) fail
                                         SynMatchClause.create
-                                            (SynPat.nameWithArgs
-                                                "Error"
-                                                [ SynPat.nameWithArgs "Some" [ SynPat.named "msg" ] |> SynPat.paren ])
-                                            (SynExpr.sequential
-                                                [
-                                                    SynExpr.createIdent "sprintf"
-                                                    |> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)")
-                                                    |> SynExpr.applyTo (SynExpr.createIdent "msg")
-                                                    |> SynExpr.applyTo (SynExpr.createIdent "arg")
-                                                    |> SynExpr.pipeThroughFunction (
-                                                        SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)
-                                                    )
-
-                                                    recurseKey
-                                                ])
+                                            (SynPat.nameWithArgs "Error" [ SynPat.named "x" ])
+                                            notMatched
                                     ]))
                             (SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue)))
                     (SynExpr.createIdent "helpText"
@@ -1027,8 +1211,8 @@ module internal ArgParserGenerator =
                             )
                             |> fun p ->
                                 match leftoverArgAcc with
-                                | ChoicePositional.Normal -> p
-                                | ChoicePositional.Choice ->
+                                | ChoicePositional.Normal _ -> p
+                                | ChoicePositional.Choice _ ->
                                     p
                                     |> SynExpr.pipeThroughFunction (
                                         SynExpr.applyFunction
@@ -1053,8 +1237,14 @@ module internal ArgParserGenerator =
         |> SynBinding.withRecursion true
 
     /// Takes a single argument, `args : string list`, and returns something of the type indicated by `recordType`.
-    let createRecordParse (parseState : Ident) (ambientRecords : RecordType list) (recordType : RecordType) : SynExpr =
-        let spec, _ = toParseSpec 0 ambientRecords recordType
+    let createRecordParse
+        (parseState : Ident)
+        (flagDus : FlagDu list)
+        (ambientRecords : RecordType list)
+        (recordType : RecordType)
+        : SynExpr
+        =
+        let spec, _ = toParseSpec 0 flagDus ambientRecords recordType
         // For each argument (positional and non-positional), create an accumulator for it.
         let nonPos, pos =
             { new ParseTreeEval<_> with
@@ -1094,9 +1284,9 @@ module internal ArgParserGenerator =
                     SynType.string
                 | Some pf ->
                     match pf.Accumulation with
-                    | ChoicePositional.Choice ->
+                    | ChoicePositional.Choice _ ->
                         pf.TargetVariable, pf.Parser, SynType.app "Choice" [ pf.TargetType ; pf.TargetType ]
-                    | ChoicePositional.Normal -> pf.TargetVariable, pf.Parser, pf.TargetType
+                    | ChoicePositional.Normal _ -> pf.TargetVariable, pf.Parser, pf.TargetType
 
             let bindings =
                 SynExpr.createIdent "ResizeArray"
@@ -1135,13 +1325,50 @@ module internal ArgParserGenerator =
                                 name
                                 |> SynExpr.pipeThroughFunction (SynExpr.createIdent "getEnvironmentVariable")
 
+                            /// Assumes access to a non-null variable `x` containing the string value.
+                            let parser =
+                                match pf.BoolCases with
+                                | Some boolLike ->
+                                    let trueCase, falseCase =
+                                        match boolLike with
+                                        | Choice2Of2 () -> SynExpr.CreateConst true, SynExpr.CreateConst false
+                                        | Choice1Of2 flag ->
+                                            FlagDu.FromBoolean flag (SynExpr.CreateConst true),
+                                            FlagDu.FromBoolean flag (SynExpr.CreateConst false)
+
+                                    // We permit environment variables to be populated with 0 and 1 as well.
+                                    SynExpr.ifThenElse
+                                        (SynExpr.applyFunction
+                                            (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                                            (SynExpr.tuple
+                                                [
+                                                    SynExpr.createIdent "x"
+                                                    SynExpr.CreateConst "1"
+                                                    SynExpr.createLongIdent
+                                                        [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                                                ]))
+                                        (SynExpr.ifThenElse
+                                            (SynExpr.applyFunction
+                                                (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                                                (SynExpr.tuple
+                                                    [
+                                                        SynExpr.createIdent "x"
+                                                        SynExpr.CreateConst "0"
+                                                        SynExpr.createLongIdent
+                                                            [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                                                    ]))
+                                            (SynExpr.createIdent "x" |> SynExpr.pipeThroughFunction pf.Parser)
+                                            falseCase)
+                                        trueCase
+                                | None -> (SynExpr.createIdent "x" |> SynExpr.pipeThroughFunction pf.Parser)
+
                             let errorMessage =
                                 SynExpr.createIdent "sprintf"
                                 |> SynExpr.applyTo (
                                     SynExpr.CreateConst
                                         "No value was supplied for %s, nor was environment variable %s set"
                                 )
-                                |> SynExpr.applyTo (SynExpr.CreateConst pf.ArgForm)
+                                |> SynExpr.applyTo pf.HumanReadableArgForm
                                 |> SynExpr.applyTo name
 
                             [
@@ -1156,9 +1383,7 @@ module internal ArgParserGenerator =
                                             unchecked
                                         ])
 
-                                SynMatchClause.create
-                                    (SynPat.named "x")
-                                    (SynExpr.createIdent "x" |> SynExpr.pipeThroughFunction pf.Parser)
+                                SynMatchClause.create (SynPat.named "x") parser
                             ]
                             |> SynExpr.createMatch result
                         | ArgumentDefaultSpec.FunctionCall name ->
@@ -1192,7 +1417,7 @@ module internal ArgParserGenerator =
                     let errorMessage =
                         SynExpr.createIdent "sprintf"
                         |> SynExpr.applyTo (SynExpr.CreateConst "Required argument '%s' received no value")
-                        |> SynExpr.applyTo (SynExpr.CreateConst pf.ArgForm)
+                        |> SynExpr.applyTo pf.HumanReadableArgForm
 
                     [
                         SynMatchClause.create
@@ -1274,15 +1499,22 @@ module internal ArgParserGenerator =
 
         let flags =
             nonPos
-            |> List.filter (fun pf ->
+            |> List.choose (fun pf ->
                 match pf.TargetType with
-                | PrimitiveType pt -> (pt |> List.map _.idText) = [ "System" ; "Boolean" ]
-                | _ -> false
+                | PrimitiveType pt ->
+                    if (pt |> List.map _.idText) = [ "System" ; "Boolean" ] then
+                        Some (pf, SynExpr.CreateConst true)
+                    else
+                        None
+                | ty ->
+                    match identifyAsFlag flagDus ty with
+                    | Some flag -> (pf, FlagDu.FromBoolean flag (SynExpr.CreateConst true)) |> Some
+                    | _ -> None
             )
 
         let leftoverArgAcc =
             match pos with
-            | None -> ChoicePositional.Normal
+            | None -> ChoicePositional.Normal None
             | Some pos -> pos.Accumulation
 
         [
@@ -1302,18 +1534,82 @@ module internal ArgParserGenerator =
             ]
         )
 
+    // 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 : SynTypeDefn list)
-        (allRecordTypes : SynTypeDefn list)
+        (allUnionTypes : UnionType list)
+        (allRecordTypes : RecordType list)
         : SynModuleOrNamespace
         =
-        // The type for which we're generating args may refer to any of these records/unions.
-        let allRecordTypes = allRecordTypes |> List.map RecordType.OfRecord
+        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 taggedType = RecordType.OfRecord taggedType
+                    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 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
@@ -1334,13 +1630,15 @@ module internal ArgParserGenerator =
             [
                 SynUnionCase.create
                     {
-                        Attrs = []
+                        Attributes = []
                         Fields = []
-                        Ident = Ident.create "AwaitingKey"
+                        Name = Ident.create "AwaitingKey"
+                        XmlDoc = Some (PreXmlDoc.create "Ready to consume a key or positional arg")
+                        Access = None
                     }
                 SynUnionCase.create
                     {
-                        Attrs = []
+                        Attributes = []
                         Fields =
                             [
                                 {
@@ -1349,7 +1647,9 @@ module internal ArgParserGenerator =
                                     Type = SynType.string
                                 }
                             ]
-                        Ident = Ident.create "AwaitingValue"
+                        Name = Ident.create "AwaitingValue"
+                        XmlDoc = Some (PreXmlDoc.create "Waiting to receive a value for the key we've already consumed")
+                        Access = None
                     }
             ]
             |> SynTypeDefnRepr.union
@@ -1366,7 +1666,7 @@ module internal ArgParserGenerator =
                 |> SynPat.annotateType (SynType.appPostfix "list" SynType.string)
 
             let parsePrime =
-                createRecordParse parseStateIdent allRecordTypes taggedType
+                createRecordParse parseStateIdent flagDus allRecordTypes taggedType
                 |> SynBinding.basic
                     [ Ident.create "parse'" ]
                     [
@@ -1464,12 +1764,12 @@ module internal ArgParserGenerator =
                         (([], [], []), types)
                         ||> List.fold (fun
                                            (unions, records, others)
-                                           (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _) as ty) ->
+                                           (SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) ->
                             match repr with
-                            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union _, _) ->
-                                ty :: unions, records, others
-                            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record _, _) ->
-                                unions, ty :: records, others
+                            | 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
                         )
 

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -67,41 +67,109 @@ type internal RecordType =
         Members : SynMemberDefns option
         XmlDoc : PreXmlDoc option
         Generics : SynTyparDecls option
-        Accessibility : SynAccess option
+        TypeAccessibility : SynAccess option
+        ImplAccessibility : SynAccess option
         Attributes : SynAttribute list
     }
 
     /// Parse from the AST.
-    static member OfRecord (record : SynTypeDefn) : RecordType =
-        let sci, sdr, smd, smdo =
-            match record with
-            | SynTypeDefn.SynTypeDefn (sci, sdr, smd, smdo, _, _) -> sci, sdr, smd, smdo
-
-        let synAccessOption, recordFields =
-            match sdr with
-            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (sa, fields, _), _) -> sa, fields
-            | _ -> failwith $"expected a record; got: %+A{record}"
-
+    static member OfRecord
+        (sci : SynComponentInfo)
+        (smd : SynMemberDefns)
+        (access : SynAccess option)
+        (recordFields : SynField list)
+        : RecordType
+        =
         match sci with
-        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access, _) ->
-            if access <> synAccessOption then
-                failwith
-                    $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{synAccessOption}"
-
-            match smdo with
-            | Some v -> failwith $"TODO what's happened, got a synMemberDefn of %O{v}"
-            | None -> ()
-
+        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
             {
                 Name = List.last longId
                 Fields = recordFields
                 Members = if smd.IsEmpty then None else Some smd
                 XmlDoc = if doc.IsEmpty then None else Some doc
                 Generics = typars
-                Accessibility = synAccessOption
+                ImplAccessibility = implAccess
+                TypeAccessibility = access
                 Attributes = attrs |> List.collect (fun l -> l.Attributes)
             }
 
+/// Methods for manipulating UnionCase.
+[<RequireQualifiedAccess>]
+module UnionCase =
+    /// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything
+    /// we care about from the AST representation.
+    let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> =
+        match case with
+        | SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) ->
+
+        let ident =
+            match ident with
+            | SynIdent.SynIdent (ident, _) -> ident
+
+        let fields =
+            match caseType with
+            | SynUnionCaseKind.Fields cases -> cases
+            | SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union"
+
+        {
+            Name = ident
+            XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc
+            Access = access
+            Attributes = attributes |> List.collect (fun t -> t.Attributes)
+            Fields = fields |> List.map SynField.extract
+        }
+
+    /// Functorial `map`.
+    let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
+        {
+            Attributes = unionCase.Attributes
+            Name = unionCase.Name
+            Access = unionCase.Access
+            XmlDoc = unionCase.XmlDoc
+            Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
+        }
+
+/// Everything you need to know about a discriminated union definition.
+type internal UnionType =
+    {
+        /// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`.
+        Name : Ident
+        /// Any additional members which are not union cases.
+        Members : SynMemberDefns option
+        /// Any docstring associated with the DU itself (not its cases).
+        XmlDoc : PreXmlDoc option
+        /// Generic type parameters this DU takes: `type Foo<'a> = | ...`.
+        Generics : SynTyparDecls option
+        /// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
+        Attributes : SynAttribute list
+        /// Accessibility modifier of the DU: `type private Foo = ...`
+        TypeAccessibility : SynAccess option
+        /// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
+        ImplAccessibility : SynAccess option
+        /// The actual DU cases themselves.
+        Cases : UnionCase<Ident option> list
+    }
+
+    static member OfUnion
+        (sci : SynComponentInfo)
+        (smd : SynMemberDefns)
+        (access : SynAccess option)
+        (cases : SynUnionCase list)
+        : UnionType
+        =
+        match sci with
+        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
+            {
+                Name = List.last longId
+                Members = if smd.IsEmpty then None else Some smd
+                XmlDoc = if doc.IsEmpty then None else Some doc
+                Generics = typars
+                Attributes = attrs |> List.collect (fun l -> l.Attributes)
+                TypeAccessibility = access
+                ImplAccessibility = implAccess
+                Cases = cases |> List.map UnionCase.ofSynUnionCase
+            }
+
 /// Anything that is part of an ADT.
 /// A record is a product of stuff; this type represents one of those stuffs.
 type internal AdtNode =
@@ -144,13 +212,13 @@ module internal AstHelper =
     let defineRecordType (record : RecordType) : SynTypeDefn =
         let name =
             SynComponentInfo.create record.Name
-            |> SynComponentInfo.setAccessibility record.Accessibility
+            |> SynComponentInfo.setAccessibility record.TypeAccessibility
             |> match record.XmlDoc with
                | None -> id
                | Some doc -> SynComponentInfo.withDocString doc
             |> SynComponentInfo.setGenerics record.Generics
 
-        SynTypeDefnRepr.record (Seq.toList record.Fields)
+        SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields)
         |> SynTypeDefn.create name
         |> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
 

WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs

@@ -212,7 +212,8 @@ module internal InterfaceMockGenerator =
                 Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
                 XmlDoc = Some xmlDoc
                 Generics = interfaceType.Generics
-                Accessibility = Some access
+                TypeAccessibility = Some access
+                ImplAccessibility = None
                 Attributes = []
             }
 

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -416,11 +416,11 @@ module internal JsonParseGenerator =
     let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
         fields
         |> List.map (fun case ->
-            let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
+            let propertyName = JsonSerializeGenerator.getPropertyName case.Name case.Attributes
 
             let body =
                 if case.Fields.IsEmpty then
-                    SynExpr.createLongIdent' (typeName @ [ case.Ident ])
+                    SynExpr.createLongIdent' (typeName @ [ case.Name ])
                 else
                     case.Fields
                     |> List.map (fun field ->
@@ -429,7 +429,7 @@ module internal JsonParseGenerator =
                         createParseRhs options propertyName field.Type
                     )
                     |> SynExpr.tuple
-                    |> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
+                    |> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Name ]))
                     |> SynExpr.createLet
                         [
                             SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
@@ -600,7 +600,7 @@ module internal JsonParseGenerator =
                     | Some i -> i
 
                 cases
-                |> List.map SynUnionCase.extract
+                |> List.map UnionCase.ofSynUnionCase
                 |> List.map (UnionCase.mapIdentFields optionGet)
                 |> createUnionMaker spec ident
             | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -263,11 +263,11 @@ module internal JsonSerializeGenerator =
 
     let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
         let inputArg = Ident.create "input"
-        let fields = cases |> List.map SynUnionCase.extract
+        let fields = cases |> List.map UnionCase.ofSynUnionCase
 
         fields
         |> List.map (fun unionCase ->
-            let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
+            let propertyName = getPropertyName unionCase.Name unionCase.Attributes
 
             let caseNames = unionCase.Fields |> List.mapi (fun i _ -> $"arg%i{i}")
 
@@ -275,7 +275,7 @@ module internal JsonSerializeGenerator =
 
             let pattern =
                 SynPat.LongIdent (
-                    SynLongIdent.create (typeName @ [ unionCase.Ident ]),
+                    SynLongIdent.create (typeName @ [ unionCase.Name ]),
                     None,
                     None,
                     argPats,

WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs

@@ -36,7 +36,6 @@ module internal RemoveOptionsGenerator =
             trivia
         )
 
-    // TODO: this option seems a bit odd
     let createType
         (xmlDoc : PreXmlDoc option)
         (accessibility : SynAccess option)
@@ -54,7 +53,8 @@ module internal RemoveOptionsGenerator =
                 Members = None
                 XmlDoc = xmlDoc
                 Generics = generics
-                Accessibility = accessibility
+                TypeAccessibility = accessibility
+                ImplAccessibility = None
                 Attributes = []
             }
 
@@ -62,7 +62,7 @@ module internal RemoveOptionsGenerator =
 
         SynModuleDecl.Types ([ typeDecl ], range0)
 
-    let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
+    let createMaker (withOptionsType : LongIdent) (withoutOptionsType : Ident) (fields : SynFieldData<Ident> list) =
         let xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
 
         let inputArg = Ident.create "input"
@@ -87,7 +87,7 @@ module internal RemoveOptionsGenerator =
                             SynExpr.applyFunction
                                 (SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
                                 (SynExpr.createLongIdent' (
-                                    withoutOptionsType
+                                    [ withoutOptionsType ]
                                     @ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
                                 ))
                         )
@@ -101,47 +101,35 @@ module internal RemoveOptionsGenerator =
             [ functionName ]
             [
                 SynPat.named inputArg.idText
-                |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
+                |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType))
             ]
             body
         |> SynBinding.withXmlDoc xmlDoc
         |> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
         |> SynModuleDecl.createLet
 
-    let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
-        let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
-            typeDefn
+    let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) =
+        let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent
 
-        let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
-            synComponentInfo
+        let decls =
+            [
+                createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields
+                createMaker [ Ident.create "Short" ] typeDefn.Name fieldData
+            ]
 
-        match synTypeDefnRepr with
-        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
-            let fieldData = fields |> List.map SynField.extractWithIdent
+        let xmlDoc =
+            sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText
+            |> PreXmlDoc.create
 
-            let decls =
-                [
-                    createType (Some doc) accessibility typeParams fields
-                    createMaker [ Ident.create "Short" ] recordId fieldData
-                ]
+        let info =
+            SynComponentInfo.create typeDefn.Name
+            |> SynComponentInfo.withDocString xmlDoc
+            |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
+            |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
 
-            let xmlDoc =
-                recordId
-                |> Seq.map (fun i -> i.idText)
-                |> String.concat "."
-                |> sprintf "Module containing an option-truncated version of the %s type"
-                |> PreXmlDoc.create
-
-            let info =
-                SynComponentInfo.createLong recordId
-                |> SynComponentInfo.withDocString xmlDoc
-                |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
-                |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
-
-            SynModuleDecl.nestedModule info decls
-            |> List.singleton
-            |> SynModuleOrNamespace.createNamespace namespaceId
-        | _ -> failwithf "Not a record type"
+        SynModuleDecl.nestedModule info decls
+        |> List.singleton
+        |> SynModuleOrNamespace.createNamespace namespaceId
 
 open Myriad.Core
 
@@ -164,7 +152,24 @@ type RemoveOptionsGenerator () =
                 |> List.choose (fun (ns, types) ->
                     match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
                     | [] -> None
-                    | types -> Some (ns, types)
+                    | types ->
+                        let types =
+                            types
+                            |> List.map (fun ty ->
+                                match ty with
+                                | SynTypeDefn.SynTypeDefn (sci,
+                                                           SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access,
+                                                                                                                 fields,
+                                                                                                                 _),
+                                                                                   _),
+                                                           smd,
+                                                           smdo,
+                                                           _,
+                                                           _) -> RecordType.OfRecord sci smd access fields
+                                | _ -> failwith "unexpectedly not a record"
+                            )
+
+                        Some (ns, types)
                 )
 
             let modules =

WoofWare.Myriad.Plugins/SurfaceBaseline.txt

@@ -11,4 +11,27 @@ WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
 WoofWare.Myriad.Plugins.JsonSerializeGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.RemoveOptionsGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
-WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj
+WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType)
+WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType
+WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident
+WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType
+WoofWare.Myriad.Plugins.UnionCase inherit obj
+WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase
+WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase
+WoofWare.Myriad.Plugins.UnionCase`1 inherit obj
+WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list)
+WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option
+WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option
+WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident
+WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option
+WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident
+WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option

WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs

@@ -80,6 +80,11 @@ module internal SynExpr =
     let equals (a : SynExpr) (b : SynExpr) =
         SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b
 
+    /// {a} && {b}
+    let booleanAnd (a : SynExpr) (b : SynExpr) =
+        SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a)
+        |> applyTo b
+
     /// {a} + {b}
     let plus (a : SynExpr) (b : SynExpr) =
         SynExpr.CreateAppInfix (

WoofWare.Myriad.Plugins/SynExpr/SynField.fs

@@ -5,10 +5,17 @@ open Fantomas.FCS.Syntax
 open Fantomas.FCS.SyntaxTrivia
 open Fantomas.FCS.Xml
 
-type internal SynFieldData<'Ident> =
+/// The data needed to reconstitute a single piece of data within a union field, or a single record field.
+/// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int`
+/// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified.
+type SynFieldData<'Ident> =
     {
+        /// Attributes on this field. I think you can only get these if this is a *record* field.
         Attrs : SynAttribute list
+        /// The identifier of this field (see docstring for SynFieldData).
         Ident : 'Ident
+        /// The type of the data contained in this field. For example, `type Foo = { Blah : int }`
+        /// has this being `int`.
         Type : SynType
     }
 

WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs

@@ -33,6 +33,9 @@ module internal SynLongIdent =
     let eq =
         SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
 
+    let booleanAnd =
+        SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
+
     let pipe =
         SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
 

WoofWare.Myriad.Plugins/SynExpr/SynType.fs

@@ -363,6 +363,7 @@ module internal SynType =
         | DateTimeOffset -> "DateTimeOffset"
         | DateOnly -> "DateOnly"
         | TimeSpan -> "TimeSpan"
+        | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident |> List.map _.idText |> String.concat "."
         | ty -> failwithf "could not compute human-readable string for type: %O" ty
 
     /// Guess whether the types are equal. We err on the side of saying "no, they're different".
@@ -454,4 +455,11 @@ module internal SynType =
             match ty2 with
             | DateOnly -> true
             | _ -> false
-        | _ -> false
+        | _ ->
+
+        match ty1, ty2 with
+        | SynType.LongIdent (SynLongIdent (ident1, _, _)), SynType.LongIdent (SynLongIdent (ident2, _, _)) ->
+            let ident1 = ident1 |> List.map _.idText
+            let ident2 = ident2 |> List.map _.idText
+            ident1 = ident2
+        | _, _ -> false

WoofWare.Myriad.Plugins/SynExpr/SynTypeDefnRepr.fs

@@ -13,8 +13,12 @@ module internal SynTypeDefnRepr =
     let inline augmentation () : SynTypeDefnRepr =
         SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
 
-    let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
-        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
+    let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
+        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
 
-    let inline record (fields : SynField list) : SynTypeDefnRepr =
-        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
+    let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
+
+    let inline recordWithAccess (implAccess : SynAccess option) (fields : SynField list) : SynTypeDefnRepr =
+        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (implAccess, fields, range0), range0)
+
+    let inline record (fields : SynField list) : SynTypeDefnRepr = recordWithAccess None fields

WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs

@@ -5,44 +5,24 @@ open Fantomas.FCS.Text.Range
 open Fantomas.FCS.Xml
 open Fantomas.FCS.SyntaxTrivia
 
-type internal UnionCase<'Ident> =
+/// Represents everything you need to know about a union case.
+/// This is generic on whether each field of this case must be named.
+type UnionCase<'ident> =
     {
-        Fields : SynFieldData<'Ident> list
-        Attrs : SynAttribute list
-        Ident : Ident
+        /// The name of the case: e.g. `| Foo of blah` has this being `Foo`.
+        Name : Ident
+        /// Any docstring associated with this case.
+        XmlDoc : PreXmlDoc option
+        /// Any accessibility modifier: e.g. `type Foo = private | Blah`.
+        Access : SynAccess option
+        /// Attributes on the case: for example, `| [<Attr>] Foo of blah`.
+        Attributes : SynAttribute list
+        /// The data contained within the case: for example, `[blah]` in `| Foo of blah`.
+        Fields : SynFieldData<'ident> list
     }
 
-[<RequireQualifiedAccess>]
-module internal UnionCase =
-    let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
-        {
-            Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
-            Attrs = unionCase.Attrs
-            Ident = unionCase.Ident
-        }
-
 [<RequireQualifiedAccess>]
 module internal SynUnionCase =
-    let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
-        match caseType with
-        | SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
-        | SynUnionCaseKind.Fields fields ->
-
-        let fields = fields |> List.map SynField.extract
-
-        let id =
-            match id with
-            | SynIdent.SynIdent (ident, _) -> ident
-
-        // As far as I can tell, there's no way to get any attributes here? :shrug:
-        let attrs = attrs |> List.collect (fun l -> l.Attributes)
-
-        {
-            Fields = fields
-            Attrs = attrs
-            Ident = id
-        }
-
     let create (case : UnionCase<Ident>) : SynUnionCase =
         let fields =
             case.Fields
@@ -63,11 +43,11 @@ module internal SynUnionCase =
             )
 
         SynUnionCase.SynUnionCase (
-            SynAttributes.ofAttrs case.Attrs,
-            SynIdent.SynIdent (case.Ident, None),
+            SynAttributes.ofAttrs case.Attributes,
+            SynIdent.SynIdent (case.Name, None),
             SynUnionCaseKind.Fields fields,
-            PreXmlDoc.Empty,
-            None,
+            case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
+            case.Access,
             range0,
             {
                 BarRange = Some range0

WoofWare.Myriad.Plugins/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "2.2",
+  "version": "2.3",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],

flake.lock

@@ -20,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1725099143,
-        "narHash": "sha256-CHgumPZaC7z+WYx72WgaLt2XF0yUVzJS60rO4GZ7ytY=",
+        "lastModified": 1725534445,
+        "narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "5629520edecb69630a3f4d17d3d33fc96c13f6fe",
+        "rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39",
         "type": "github"
       },
       "original": {

nix/deps.nix

@@ -8,8 +8,8 @@
   })
   (fetchNuGet {
     pname = "fantomas";
-    version = "6.3.11";
-    hash = "sha256-11bHGEAZTNtdp2pTg5zqLrQiyI/j/AT7GGL/2CR4+dw=";
+    version = "6.3.12";
+    hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
   })
   (fetchNuGet {
     pname = "Fantomas.Core";
@@ -78,13 +78,13 @@
   })
   (fetchNuGet {
     pname = "Microsoft.CodeCoverage";
-    version = "17.11.0";
-    hash = "sha256-XglInnx5GePUYHG7n2NLX+WfK7kJnornsWOW/5FnOXE=";
+    version = "17.11.1";
+    hash = "sha256-1dLlK3NGh88PuFYZiYpT+izA96etxhU3BSgixDgdtGA=";
   })
   (fetchNuGet {
     pname = "Microsoft.NET.Test.Sdk";
-    version = "17.11.0";
-    hash = "sha256-WjyA78+PG9ZloWTt9Hf1ek3VVj2FfJ9fAjqklnN+fWw=";
+    version = "17.11.1";
+    hash = "sha256-0JUEucQ2lzaPgkrjm/NFLBTbqU1dfhvhN3Tl3moE6mI=";
   })
   (fetchNuGet {
     pname = "Microsoft.NETCore.App.Host.linux-arm64";
@@ -153,13 +153,13 @@
   })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.ObjectModel";
-    version = "17.11.0";
-    hash = "sha256-mCI3MCV6nyrGLrBat5VvK5LrXTEKlsdp9NkpZyJYwVg=";
+    version = "17.11.1";
+    hash = "sha256-5vX+vCzFY3S7xfMVIv8OlMMFtdedW9UIJzc0WEc+vm4=";
   })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.TestHost";
-    version = "17.11.0";
-    hash = "sha256-gViDLobza22kuLvB4JdlGtbANqwBHRwf1wLmIHMw9Eo=";
+    version = "17.11.1";
+    hash = "sha256-wSkY0H1fQAq0H3LcKT4u7Y5RzhAAPa6yueVN84g8HxU=";
   })
   (fetchNuGet {
     pname = "Myriad.Core";