Implement [<ArgumentFlag>] for two-case DUs (#242)

ConsumePlugin/Args.fs

@@ -111,7 +111,7 @@ type ChildRecordWithPositional =
     {
         Thing1 : int
         [<PositionalArgs>]
-        Thing2 : string list
+        Thing2 : Uri list
     }
 
 [<ArgParser true>]
@@ -135,3 +135,46 @@ 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

ConsumePlugin/GeneratedArgs.fs

@@ -18,7 +18,9 @@ open WoofWare.Myriad.Plugins
 [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module BasicNoPositionals =
     type private ParseState_BasicNoPositionals =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicNoPositionals =
@@ -96,7 +98,7 @@ module BasicNoPositionals =
                     sprintf "Flag '%s' was supplied multiple times" "--baz" |> ArgParser_errors.Add
                     true
                 | None ->
-                    arg_2 <- Some true
+                    arg_2 <- true |> Some
                     true
             else
                 false
@@ -216,7 +218,9 @@ open WoofWare.Myriad.Plugins
 [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module Basic =
     type private ParseState_Basic =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     let parse' (getEnvironmentVariable : string -> string) (args : string list) : Basic =
@@ -296,7 +300,7 @@ module Basic =
                     sprintf "Flag '%s' was supplied multiple times" "--baz" |> ArgParser_errors.Add
                     true
                 | None ->
-                    arg_2 <- Some true
+                    arg_2 <- true |> Some
                     true
             else
                 false
@@ -404,7 +408,9 @@ open WoofWare.Myriad.Plugins
 [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module BasicWithIntPositionals =
     type private ParseState_BasicWithIntPositionals =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     let parse' (getEnvironmentVariable : string -> string) (args : string list) : BasicWithIntPositionals =
@@ -481,7 +487,7 @@ module BasicWithIntPositionals =
                     sprintf "Flag '%s' was supplied multiple times" "--baz" |> ArgParser_errors.Add
                     true
                 | None ->
-                    arg_2 <- Some true
+                    arg_2 <- true |> Some
                     true
             else
                 false
@@ -589,7 +595,9 @@ open WoofWare.Myriad.Plugins
 [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module LoadsOfTypes =
     type private ParseState_LoadsOfTypes =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypes =
@@ -793,7 +801,7 @@ module LoadsOfTypes =
 
                     true
                 | None ->
-                    arg_8 <- Some true
+                    arg_8 <- true |> Some
                     true
             else if System.String.Equals (key, "--baz", System.StringComparison.OrdinalIgnoreCase) then
                 match arg_2 with
@@ -801,7 +809,7 @@ module LoadsOfTypes =
                     sprintf "Flag '%s' was supplied multiple times" "--baz" |> ArgParser_errors.Add
                     true
                 | None ->
-                    arg_2 <- Some true
+                    arg_2 <- true |> Some
                     true
             else
                 false
@@ -963,7 +971,9 @@ open WoofWare.Myriad.Plugins
 [<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module LoadsOfTypesNoPositionals =
     type private ParseState_LoadsOfTypesNoPositionals =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     let parse' (getEnvironmentVariable : string -> string) (args : string list) : LoadsOfTypesNoPositionals =
@@ -1164,7 +1174,7 @@ module LoadsOfTypesNoPositionals =
 
                     true
                 | None ->
-                    arg_7 <- Some true
+                    arg_7 <- true |> Some
                     true
             else if System.String.Equals (key, "--baz", System.StringComparison.OrdinalIgnoreCase) then
                 match arg_2 with
@@ -1172,7 +1182,7 @@ module LoadsOfTypesNoPositionals =
                     sprintf "Flag '%s' was supplied multiple times" "--baz" |> ArgParser_errors.Add
                     true
                 | None ->
-                    arg_2 <- Some true
+                    arg_2 <- true |> Some
                     true
             else
                 false
@@ -1343,7 +1353,9 @@ open WoofWare.Myriad.Plugins
 [<AutoOpen>]
 module DatesAndTimesArgParse =
     type private ParseState_DatesAndTimes =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     /// Extension methods for argument parsing
@@ -1587,7 +1599,9 @@ open WoofWare.Myriad.Plugins
 [<AutoOpen>]
 module ParentRecordArgParse =
     type private ParseState_ParentRecord =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     /// Extension methods for argument parsing
@@ -1665,7 +1679,7 @@ module ParentRecordArgParse =
 
                         true
                     | None ->
-                        arg_2 <- Some true
+                        arg_2 <- true |> Some
                         true
                 else
                     false
@@ -1788,7 +1802,9 @@ open WoofWare.Myriad.Plugins
 [<AutoOpen>]
 module ParentRecordChildPosArgParse =
     type private ParseState_ParentRecordChildPos =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     /// Extension methods for argument parsing
@@ -1801,11 +1817,11 @@ module ParentRecordChildPosArgParse =
                 [
                     (sprintf "--and-another  bool%s%s" "" "")
                     (sprintf "--thing1  int32%s%s" "" "")
-                    (sprintf "--thing2  string%s%s" " (positional args) (can be repeated)" "")
+                    (sprintf "--thing2  URI%s%s" " (positional args) (can be repeated)" "")
                 ]
                 |> String.concat "\n"
 
-            let arg_1 : string ResizeArray = ResizeArray ()
+            let arg_1 : Uri ResizeArray = ResizeArray ()
             let mutable arg_2 : bool option = None
             let mutable arg_0 : int option = None
 
@@ -1840,7 +1856,7 @@ module ParentRecordChildPosArgParse =
                         with _ as exc ->
                             exc.Message |> Some |> Error
                 else if System.String.Equals (key, "--thing2", System.StringComparison.OrdinalIgnoreCase) then
-                    value |> (fun x -> x) |> arg_1.Add
+                    value |> (fun x -> System.Uri x) |> arg_1.Add
                     () |> Ok
                 else
                     Error None
@@ -1855,7 +1871,7 @@ module ParentRecordChildPosArgParse =
 
                         true
                     | None ->
-                        arg_2 <- Some true
+                        arg_2 <- true |> Some
                         true
                 else
                     false
@@ -1873,7 +1889,7 @@ module ParentRecordChildPosArgParse =
                                 "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
                                 key
                             |> ArgParser_errors.Add
-                | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x))
+                | "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Uri x))
                 | arg :: args ->
                     match state with
                     | ParseState_ParentRecordChildPos.AwaitingKey ->
@@ -1897,7 +1913,7 @@ module ParentRecordChildPosArgParse =
                                         sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
                                         go ParseState_ParentRecordChildPos.AwaitingKey args
                         else
-                            arg |> (fun x -> x) |> arg_1.Add
+                            arg |> (fun x -> System.Uri x) |> arg_1.Add
                             go ParseState_ParentRecordChildPos.AwaitingKey args
                     | ParseState_ParentRecordChildPos.AwaitingValue key ->
                         match processKeyValue key arg with
@@ -1959,7 +1975,9 @@ open WoofWare.Myriad.Plugins
 [<AutoOpen>]
 module ParentRecordSelfPosArgParse =
     type private ParseState_ParentRecordSelfPos =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     /// Extension methods for argument parsing
@@ -2118,7 +2136,9 @@ open WoofWare.Myriad.Plugins
 [<AutoOpen>]
 module ChoicePositionalsArgParse =
     type private ParseState_ChoicePositionals =
+        /// Ready to consume a key or positional arg
         | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
         | AwaitingValue of key : string
 
     /// Extension methods for argument parsing
@@ -2212,3 +2232,695 @@ module ChoicePositionalsArgParse =
 
         static member parse (args : string list) : ChoicePositionals =
             ChoicePositionals.parse' System.Environment.GetEnvironmentVariable args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type ContainsBoolEnvVar
+[<AutoOpen>]
+module ContainsBoolEnvVarArgParse =
+    type private ParseState_ContainsBoolEnvVar =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    /// Extension methods for argument parsing
+    type ContainsBoolEnvVar with
+
+        static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsBoolEnvVar =
+            let ArgParser_errors = ResizeArray ()
+
+            let helpText () =
+                [
+                    (sprintf
+                        "--bool-var  bool%s%s"
+                        ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)")
+                        "")
+                ]
+                |> String.concat "\n"
+
+            let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+            let mutable arg_0 : bool option = None
+
+            /// Processes the key-value pair, returning Error if no key was matched.
+            /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+            /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+            let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+                if System.String.Equals (key, "--bool-var", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Argument '%s' was supplied multiple times: %O and %O" "--bool-var" x value
+                        |> ArgParser_errors.Add
+
+                        Ok ()
+                    | None ->
+                        try
+                            arg_0 <- value |> (fun x -> System.Boolean.Parse x) |> Some
+                            Ok ()
+                        with _ as exc ->
+                            exc.Message |> Some |> Error
+                else
+                    Error None
+
+            /// Returns false if we didn't set a value.
+            let setFlagValue (key : string) : bool =
+                if System.String.Equals (key, "--bool-var", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Flag '%s' was supplied multiple times" "--bool-var"
+                        |> ArgParser_errors.Add
+
+                        true
+                    | None ->
+                        arg_0 <- true |> Some
+                        true
+                else
+                    false
+
+            let rec go (state : ParseState_ContainsBoolEnvVar) (args : string list) =
+                match args with
+                | [] ->
+                    match state with
+                    | ParseState_ContainsBoolEnvVar.AwaitingKey -> ()
+                    | ParseState_ContainsBoolEnvVar.AwaitingValue key ->
+                        if setFlagValue key then
+                            ()
+                        else
+                            sprintf
+                                "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                                key
+                            |> ArgParser_errors.Add
+                | "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+                | arg :: args ->
+                    match state with
+                    | ParseState_ContainsBoolEnvVar.AwaitingKey ->
+                        if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                            if arg = "--help" then
+                                helpText () |> failwithf "Help text requested.\n%s"
+                            else
+                                let equals = arg.IndexOf (char 61)
+
+                                if equals < 0 then
+                                    args |> go (ParseState_ContainsBoolEnvVar.AwaitingValue arg)
+                                else
+                                    let key = arg.[0 .. equals - 1]
+                                    let value = arg.[equals + 1 ..]
+
+                                    match processKeyValue key value with
+                                    | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args
+                                    | Error None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Error (Some msg) ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_ContainsBoolEnvVar.AwaitingKey args
+                        else
+                            arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                            go ParseState_ContainsBoolEnvVar.AwaitingKey args
+                    | ParseState_ContainsBoolEnvVar.AwaitingValue key ->
+                        match processKeyValue key arg with
+                        | Ok () -> go ParseState_ContainsBoolEnvVar.AwaitingKey args
+                        | Error exc ->
+                            if setFlagValue key then
+                                go ParseState_ContainsBoolEnvVar.AwaitingKey (arg :: args)
+                            else
+                                match exc with
+                                | None ->
+                                    failwithf
+                                        "Unable to process supplied arg %s. Help text follows.\n%s"
+                                        key
+                                        (helpText ())
+                                | Some msg -> msg |> ArgParser_errors.Add
+
+            go ParseState_ContainsBoolEnvVar.AwaitingKey args
+
+            let parser_LeftoverArgs =
+                if 0 = parser_LeftoverArgs.Count then
+                    ()
+                else
+                    parser_LeftoverArgs
+                    |> String.concat " "
+                    |> sprintf "There were leftover args: %s"
+                    |> ArgParser_errors.Add
+
+                    Unchecked.defaultof<_>
+
+            let arg_0 =
+                match arg_0 with
+                | None ->
+                    match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with
+                    | null ->
+                        sprintf
+                            "No value was supplied for %s, nor was environment variable %s set"
+                            "--bool-var"
+                            "CONSUMEPLUGIN_THINGS"
+                        |> ArgParser_errors.Add
+
+                        Unchecked.defaultof<_>
+                    | x ->
+                        if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then
+                            true
+                        else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then
+                            false
+                        else
+                            x |> (fun x -> System.Boolean.Parse x)
+                    |> Choice2Of2
+                | Some x -> Choice1Of2 x
+
+            if 0 = ArgParser_errors.Count then
+                {
+                    BoolVar = arg_0
+                }
+            else
+                ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+        static member parse (args : string list) : ContainsBoolEnvVar =
+            ContainsBoolEnvVar.parse' System.Environment.GetEnvironmentVariable args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type WithFlagDu
+[<AutoOpen>]
+module WithFlagDuArgParse =
+    type private ParseState_WithFlagDu =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    /// Extension methods for argument parsing
+    type WithFlagDu with
+
+        static member parse' (getEnvironmentVariable : string -> string) (args : string list) : WithFlagDu =
+            let ArgParser_errors = ResizeArray ()
+
+            let helpText () =
+                [ (sprintf "--dry-run  bool%s%s" "" "") ] |> String.concat "\n"
+
+            let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+            let mutable arg_0 : DryRunMode option = None
+
+            /// Processes the key-value pair, returning Error if no key was matched.
+            /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+            /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+            let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Argument '%s' was supplied multiple times: %O and %O" "--dry-run" x value
+                        |> ArgParser_errors.Add
+
+                        Ok ()
+                    | None ->
+                        try
+                            arg_0 <-
+                                value
+                                |> (fun x ->
+                                    if System.Boolean.Parse x = Consts.FALSE then
+                                        DryRunMode.Wet
+                                    else
+                                        DryRunMode.Dry
+                                )
+                                |> Some
+
+                            Ok ()
+                        with _ as exc ->
+                            exc.Message |> Some |> Error
+                else
+                    Error None
+
+            /// Returns false if we didn't set a value.
+            let setFlagValue (key : string) : bool =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Flag '%s' was supplied multiple times" "--dry-run"
+                        |> ArgParser_errors.Add
+
+                        true
+                    | None ->
+                        arg_0 <-
+                            if true = Consts.FALSE then
+                                DryRunMode.Wet
+                            else
+                                DryRunMode.Dry
+                            |> Some
+
+                        true
+                else
+                    false
+
+            let rec go (state : ParseState_WithFlagDu) (args : string list) =
+                match args with
+                | [] ->
+                    match state with
+                    | ParseState_WithFlagDu.AwaitingKey -> ()
+                    | ParseState_WithFlagDu.AwaitingValue key ->
+                        if setFlagValue key then
+                            ()
+                        else
+                            sprintf
+                                "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                                key
+                            |> ArgParser_errors.Add
+                | "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+                | arg :: args ->
+                    match state with
+                    | ParseState_WithFlagDu.AwaitingKey ->
+                        if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                            if arg = "--help" then
+                                helpText () |> failwithf "Help text requested.\n%s"
+                            else
+                                let equals = arg.IndexOf (char 61)
+
+                                if equals < 0 then
+                                    args |> go (ParseState_WithFlagDu.AwaitingValue arg)
+                                else
+                                    let key = arg.[0 .. equals - 1]
+                                    let value = arg.[equals + 1 ..]
+
+                                    match processKeyValue key value with
+                                    | Ok () -> go ParseState_WithFlagDu.AwaitingKey args
+                                    | Error None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Error (Some msg) ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_WithFlagDu.AwaitingKey args
+                        else
+                            arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                            go ParseState_WithFlagDu.AwaitingKey args
+                    | ParseState_WithFlagDu.AwaitingValue key ->
+                        match processKeyValue key arg with
+                        | Ok () -> go ParseState_WithFlagDu.AwaitingKey args
+                        | Error exc ->
+                            if setFlagValue key then
+                                go ParseState_WithFlagDu.AwaitingKey (arg :: args)
+                            else
+                                match exc with
+                                | None ->
+                                    failwithf
+                                        "Unable to process supplied arg %s. Help text follows.\n%s"
+                                        key
+                                        (helpText ())
+                                | Some msg -> msg |> ArgParser_errors.Add
+
+            go ParseState_WithFlagDu.AwaitingKey args
+
+            let parser_LeftoverArgs =
+                if 0 = parser_LeftoverArgs.Count then
+                    ()
+                else
+                    parser_LeftoverArgs
+                    |> String.concat " "
+                    |> sprintf "There were leftover args: %s"
+                    |> ArgParser_errors.Add
+
+                    Unchecked.defaultof<_>
+
+            let arg_0 =
+                match arg_0 with
+                | None ->
+                    sprintf "Required argument '%s' received no value" "--dry-run"
+                    |> ArgParser_errors.Add
+
+                    Unchecked.defaultof<_>
+                | Some x -> x
+
+            if 0 = ArgParser_errors.Count then
+                {
+                    DryRun = arg_0
+                }
+            else
+                ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+        static member parse (args : string list) : WithFlagDu =
+            WithFlagDu.parse' System.Environment.GetEnvironmentVariable args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type ContainsFlagEnvVar
+[<AutoOpen>]
+module ContainsFlagEnvVarArgParse =
+    type private ParseState_ContainsFlagEnvVar =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    /// Extension methods for argument parsing
+    type ContainsFlagEnvVar with
+
+        static member parse' (getEnvironmentVariable : string -> string) (args : string list) : ContainsFlagEnvVar =
+            let ArgParser_errors = ResizeArray ()
+
+            let helpText () =
+                [
+                    (sprintf
+                        "--dry-run  bool%s%s"
+                        ("CONSUMEPLUGIN_THINGS" |> sprintf " (default value populated from env var %s)")
+                        "")
+                ]
+                |> String.concat "\n"
+
+            let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+            let mutable arg_0 : DryRunMode option = None
+
+            /// Processes the key-value pair, returning Error if no key was matched.
+            /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+            /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+            let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Argument '%s' was supplied multiple times: %O and %O" "--dry-run" x value
+                        |> ArgParser_errors.Add
+
+                        Ok ()
+                    | None ->
+                        try
+                            arg_0 <-
+                                value
+                                |> (fun x ->
+                                    if System.Boolean.Parse x = Consts.FALSE then
+                                        DryRunMode.Wet
+                                    else
+                                        DryRunMode.Dry
+                                )
+                                |> Some
+
+                            Ok ()
+                        with _ as exc ->
+                            exc.Message |> Some |> Error
+                else
+                    Error None
+
+            /// Returns false if we didn't set a value.
+            let setFlagValue (key : string) : bool =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Flag '%s' was supplied multiple times" "--dry-run"
+                        |> ArgParser_errors.Add
+
+                        true
+                    | None ->
+                        arg_0 <-
+                            if true = Consts.FALSE then
+                                DryRunMode.Wet
+                            else
+                                DryRunMode.Dry
+                            |> Some
+
+                        true
+                else
+                    false
+
+            let rec go (state : ParseState_ContainsFlagEnvVar) (args : string list) =
+                match args with
+                | [] ->
+                    match state with
+                    | ParseState_ContainsFlagEnvVar.AwaitingKey -> ()
+                    | ParseState_ContainsFlagEnvVar.AwaitingValue key ->
+                        if setFlagValue key then
+                            ()
+                        else
+                            sprintf
+                                "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                                key
+                            |> ArgParser_errors.Add
+                | "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+                | arg :: args ->
+                    match state with
+                    | ParseState_ContainsFlagEnvVar.AwaitingKey ->
+                        if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                            if arg = "--help" then
+                                helpText () |> failwithf "Help text requested.\n%s"
+                            else
+                                let equals = arg.IndexOf (char 61)
+
+                                if equals < 0 then
+                                    args |> go (ParseState_ContainsFlagEnvVar.AwaitingValue arg)
+                                else
+                                    let key = arg.[0 .. equals - 1]
+                                    let value = arg.[equals + 1 ..]
+
+                                    match processKeyValue key value with
+                                    | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args
+                                    | Error None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Error (Some msg) ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_ContainsFlagEnvVar.AwaitingKey args
+                        else
+                            arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                            go ParseState_ContainsFlagEnvVar.AwaitingKey args
+                    | ParseState_ContainsFlagEnvVar.AwaitingValue key ->
+                        match processKeyValue key arg with
+                        | Ok () -> go ParseState_ContainsFlagEnvVar.AwaitingKey args
+                        | Error exc ->
+                            if setFlagValue key then
+                                go ParseState_ContainsFlagEnvVar.AwaitingKey (arg :: args)
+                            else
+                                match exc with
+                                | None ->
+                                    failwithf
+                                        "Unable to process supplied arg %s. Help text follows.\n%s"
+                                        key
+                                        (helpText ())
+                                | Some msg -> msg |> ArgParser_errors.Add
+
+            go ParseState_ContainsFlagEnvVar.AwaitingKey args
+
+            let parser_LeftoverArgs =
+                if 0 = parser_LeftoverArgs.Count then
+                    ()
+                else
+                    parser_LeftoverArgs
+                    |> String.concat " "
+                    |> sprintf "There were leftover args: %s"
+                    |> ArgParser_errors.Add
+
+                    Unchecked.defaultof<_>
+
+            let arg_0 =
+                match arg_0 with
+                | None ->
+                    match "CONSUMEPLUGIN_THINGS" |> getEnvironmentVariable with
+                    | null ->
+                        sprintf
+                            "No value was supplied for %s, nor was environment variable %s set"
+                            "--dry-run"
+                            "CONSUMEPLUGIN_THINGS"
+                        |> ArgParser_errors.Add
+
+                        Unchecked.defaultof<_>
+                    | x ->
+                        if System.String.Equals (x, "1", System.StringComparison.OrdinalIgnoreCase) then
+                            if true = Consts.FALSE then
+                                DryRunMode.Wet
+                            else
+                                DryRunMode.Dry
+                        else if System.String.Equals (x, "0", System.StringComparison.OrdinalIgnoreCase) then
+                            if false = Consts.FALSE then
+                                DryRunMode.Wet
+                            else
+                                DryRunMode.Dry
+                        else
+                            x
+                            |> (fun x ->
+                                if System.Boolean.Parse x = Consts.FALSE then
+                                    DryRunMode.Wet
+                                else
+                                    DryRunMode.Dry
+                            )
+                    |> Choice2Of2
+                | Some x -> Choice1Of2 x
+
+            if 0 = ArgParser_errors.Count then
+                {
+                    DryRun = arg_0
+                }
+            else
+                ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+        static member parse (args : string list) : ContainsFlagEnvVar =
+            ContainsFlagEnvVar.parse' System.Environment.GetEnvironmentVariable args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type ContainsFlagDefaultValue
+[<AutoOpen>]
+module ContainsFlagDefaultValueArgParse =
+    type private ParseState_ContainsFlagDefaultValue =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    /// Extension methods for argument parsing
+    type ContainsFlagDefaultValue with
+
+        static member parse'
+            (getEnvironmentVariable : string -> string)
+            (args : string list)
+            : ContainsFlagDefaultValue
+            =
+            let ArgParser_errors = ResizeArray ()
+
+            let helpText () =
+                [
+                    (sprintf
+                        "--dry-run  bool%s%s"
+                        (match ContainsFlagDefaultValue.DefaultDryRun () with
+                         | DryRunMode.Wet -> if Consts.FALSE = true then "true" else "false"
+                         | DryRunMode.Dry -> if true = true then "true" else "false"
+                         |> sprintf " (default value: %O)")
+                        "")
+                ]
+                |> String.concat "\n"
+
+            let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+            let mutable arg_0 : DryRunMode option = None
+
+            /// Processes the key-value pair, returning Error if no key was matched.
+            /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+            /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+            let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Argument '%s' was supplied multiple times: %O and %O" "--dry-run" x value
+                        |> ArgParser_errors.Add
+
+                        Ok ()
+                    | None ->
+                        try
+                            arg_0 <-
+                                value
+                                |> (fun x ->
+                                    if System.Boolean.Parse x = Consts.FALSE then
+                                        DryRunMode.Wet
+                                    else
+                                        DryRunMode.Dry
+                                )
+                                |> Some
+
+                            Ok ()
+                        with _ as exc ->
+                            exc.Message |> Some |> Error
+                else
+                    Error None
+
+            /// Returns false if we didn't set a value.
+            let setFlagValue (key : string) : bool =
+                if System.String.Equals (key, "--dry-run", System.StringComparison.OrdinalIgnoreCase) then
+                    match arg_0 with
+                    | Some x ->
+                        sprintf "Flag '%s' was supplied multiple times" "--dry-run"
+                        |> ArgParser_errors.Add
+
+                        true
+                    | None ->
+                        arg_0 <-
+                            if true = Consts.FALSE then
+                                DryRunMode.Wet
+                            else
+                                DryRunMode.Dry
+                            |> Some
+
+                        true
+                else
+                    false
+
+            let rec go (state : ParseState_ContainsFlagDefaultValue) (args : string list) =
+                match args with
+                | [] ->
+                    match state with
+                    | ParseState_ContainsFlagDefaultValue.AwaitingKey -> ()
+                    | ParseState_ContainsFlagDefaultValue.AwaitingValue key ->
+                        if setFlagValue key then
+                            ()
+                        else
+                            sprintf
+                                "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                                key
+                            |> ArgParser_errors.Add
+                | "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+                | arg :: args ->
+                    match state with
+                    | ParseState_ContainsFlagDefaultValue.AwaitingKey ->
+                        if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                            if arg = "--help" then
+                                helpText () |> failwithf "Help text requested.\n%s"
+                            else
+                                let equals = arg.IndexOf (char 61)
+
+                                if equals < 0 then
+                                    args |> go (ParseState_ContainsFlagDefaultValue.AwaitingValue arg)
+                                else
+                                    let key = arg.[0 .. equals - 1]
+                                    let value = arg.[equals + 1 ..]
+
+                                    match processKeyValue key value with
+                                    | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args
+                                    | Error None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Error (Some msg) ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_ContainsFlagDefaultValue.AwaitingKey args
+                        else
+                            arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                            go ParseState_ContainsFlagDefaultValue.AwaitingKey args
+                    | ParseState_ContainsFlagDefaultValue.AwaitingValue key ->
+                        match processKeyValue key arg with
+                        | Ok () -> go ParseState_ContainsFlagDefaultValue.AwaitingKey args
+                        | Error exc ->
+                            if setFlagValue key then
+                                go ParseState_ContainsFlagDefaultValue.AwaitingKey (arg :: args)
+                            else
+                                match exc with
+                                | None ->
+                                    failwithf
+                                        "Unable to process supplied arg %s. Help text follows.\n%s"
+                                        key
+                                        (helpText ())
+                                | Some msg -> msg |> ArgParser_errors.Add
+
+            go ParseState_ContainsFlagDefaultValue.AwaitingKey args
+
+            let parser_LeftoverArgs =
+                if 0 = parser_LeftoverArgs.Count then
+                    ()
+                else
+                    parser_LeftoverArgs
+                    |> String.concat " "
+                    |> sprintf "There were leftover args: %s"
+                    |> ArgParser_errors.Add
+
+                    Unchecked.defaultof<_>
+
+            let arg_0 =
+                match arg_0 with
+                | None -> ContainsFlagDefaultValue.DefaultDryRun () |> Choice2Of2
+                | Some x -> Choice1Of2 x
+
+            if 0 = ArgParser_errors.Count then
+                {
+                    DryRun = arg_0
+                }
+            else
+                ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+        static member parse (args : string list) : ContainsFlagDefaultValue =
+            ContainsFlagDefaultValue.parse' System.Environment.GetEnvironmentVariable args

WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs

@@ -61,3 +61,12 @@ 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 ()

WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt

@@ -7,6 +7,8 @@ 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.CreateCatamorphismAttribute inherit System.Attribute

WoofWare.Myriad.Plugins.Attributes/version.json

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

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,121 @@ 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"""

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> =
@@ -33,6 +51,13 @@ type private ParseFunction<'acc> =
         FieldName : Ident
         TargetVariable : Ident
         ArgForm : string
+        /// 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
@@ -236,12 +261,24 @@ module internal ArgParserGenerator =
 
         result.ToString ()
 
+    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`).
     /// The resulting SynType is the type of the *element* being parsed; so if the Accumulation is List, the SynType
     /// 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 +294,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 +371,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 +391,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 +429,7 @@ module internal ArgParserGenerator =
                         | [ "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ]
                         | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariable" ]
                         | [ "WoofWare" ; "Myriad" ; "Plugins" ; "ArgumentDefaultEnvironmentVariableAttribute" ] ->
+
                             ArgumentDefaultSpec.EnvironmentVariable attr.ArgExpr |> Some
                         | _ -> None
                     )
@@ -404,13 +449,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
@@ -483,7 +541,7 @@ 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 ->
 
@@ -497,7 +555,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 _) ->
@@ -513,6 +577,7 @@ module internal ArgParserGenerator =
                             TargetType = parseTy
                             ArgForm = argify ident
                             Help = helpText
+                            BoolCases = isBoolLike
                         }
                         |> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
                     | Accumulation.List Accumulation.Required ->
@@ -524,6 +589,7 @@ module internal ArgParserGenerator =
                             TargetType = parseTy
                             ArgForm = argify ident
                             Help = helpText
+                            BoolCases = isBoolLike
                         }
                         |> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
                     | Accumulation.Choice _
@@ -540,7 +606,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
@@ -550,6 +622,7 @@ module internal ArgParserGenerator =
                         TargetType = parseTy
                         ArgForm = argify ident
                         Help = helpText
+                        BoolCases = isBoolLike
                     }
                     |> fun t -> ParseTree.NonPositionalLeaf (t, Teq.refl)
                     |> ParseTreeCrate.make
@@ -575,7 +648,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 +667,43 @@ 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.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,7 +713,7 @@ 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}"
 
@@ -759,9 +861,12 @@ 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")
@@ -783,7 +888,7 @@ module internal ArgParserGenerator =
                     ([
                         SynExpr.assign
                             (SynLongIdent.createI flag.TargetVariable)
-                            (SynExpr.applyFunction (SynExpr.createIdent "Some") (SynExpr.CreateConst true))
+                            (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase)
                         SynExpr.CreateConst true
                      ]
                      |> SynExpr.sequential)
@@ -1053,8 +1158,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
@@ -1135,6 +1246,43 @@ 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 (
@@ -1156,9 +1304,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 ->
@@ -1274,10 +1420,17 @@ 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 =
@@ -1302,18 +1455,81 @@ 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 ] ->
+                    match c1.Fields, c2.Fields with
+                    | [], [] ->
+                        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 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."
+                            | _, _ -> ()
+
+                            {
+                                Name = ty.Name
+                                Case1Name = c1.Name
+                                Case1Arg = c1Attr
+                                Case2Name = c2.Name
+                                Case2Arg = c2Attr
+                            }
+                            |> Some
+                        | 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
+                    | _, _ ->
+                        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 +1550,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 +1567,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 +1586,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 +1684,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

@@ -72,25 +72,17 @@ type internal RecordType =
     }
 
     /// 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, _, access2, _) ->
+            if access <> access2 then
+                failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
 
             {
                 Name = List.last longId
@@ -98,10 +90,87 @@ type internal RecordType =
                 Members = if smd.IsEmpty then None else Some smd
                 XmlDoc = if doc.IsEmpty then None else Some doc
                 Generics = typars
-                Accessibility = synAccessOption
+                Accessibility = 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 = ...`
+        Accessibility : 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, _, access2, _) ->
+            if access <> access2 then
+                failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
+
+            {
+                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)
+                Accessibility = access
+                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 =

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/SurfaceBaseline.txt

@@ -12,3 +12,26 @@ WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Co
 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.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/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/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/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$"
   ],