Add no-attribute support for CreateCatamorphism (#461)

* Bump WoofWare.Expect from 0.8.4 to 0.8.5

---
updated-dependencies:
- dependency-name: WoofWare.Expect
  dependency-version: 0.8.5
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

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

* Deps

---------

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

.github/workflows/dotnet.yaml

@@ -25,7 +25,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-    - uses: actions/checkout@v5
+    - uses: actions/checkout@v6
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
@@ -46,7 +46,7 @@ jobs:
       security-events: write
     steps:
       - name: Checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
         with:
           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
       - name: Install Nix
@@ -65,7 +65,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
       - name: Install Nix
         uses: cachix/install-nix-action@v31
         with:
@@ -80,7 +80,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
       - name: Install Nix
         uses: cachix/install-nix-action@v31
         with:
@@ -93,7 +93,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
         with:
           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
       - name: Install Nix
@@ -114,7 +114,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
       - name: Install Nix
         uses: cachix/install-nix-action@v31
         with:
@@ -152,7 +152,7 @@ jobs:
   nuget-pack:
     runs-on: ubuntu-latest
     steps:
-    - uses: actions/checkout@v5
+    - uses: actions/checkout@v6
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
@@ -207,7 +207,7 @@ jobs:
     runs-on: ubuntu-latest
     needs: [nuget-pack]
     steps:
-      - uses: actions/checkout@v5
+      - uses: actions/checkout@v6
       - name: Download NuGet artifact
         uses: actions/download-artifact@v6
         with:
@@ -287,7 +287,7 @@ jobs:
       attestations: write
       contents: read
     steps:
-      - uses: actions/checkout@v5
+      - uses: actions/checkout@v6
       - name: Install Nix
         uses: cachix/install-nix-action@v31
         with:
@@ -325,7 +325,7 @@ jobs:
       attestations: write
       contents: read
     steps:
-      - uses: actions/checkout@v5
+      - uses: actions/checkout@v6
       - name: Install Nix
         uses: cachix/install-nix-action@v31
         with:
@@ -366,7 +366,7 @@ jobs:
     permissions:
       contents: write
     steps:
-      - uses: actions/checkout@v5
+      - uses: actions/checkout@v6
       - name: Download NuGet artifact
         uses: actions/download-artifact@v6
         with:

.github/workflows/flake_update.yaml

@@ -11,7 +11,7 @@ jobs:
     runs-on: ubuntu-latest
     steps:
       - name: Check out repository
-        uses: actions/checkout@v5
+        uses: actions/checkout@v6
 
       - name: Install Nix
         uses: DeterminateSystems/nix-installer-action@main

ConsumePlugin/Args.fs

@@ -235,3 +235,27 @@ type FlagsIntoPositionalArgs' =
         [<PositionalArgs false>]
         DontGrabEverything : string list
     }
+
+[<ArgParser>]
+[<ArgumentHelpText "Parse command-line arguments for a basic configuration. This help text appears before the argument list.">]
+type WithTypeHelp =
+    {
+        [<ArgumentHelpText "The configuration file path">]
+        ConfigFile : string
+        [<ArgumentHelpText "Enable verbose output">]
+        Verbose : bool
+        Port : int
+    }
+
+[<ArgParser>]
+[<ArgumentHelpText "This is a multiline help text example.
+It spans multiple lines to test that multiline strings work correctly.
+You can use this to provide detailed documentation for your argument parser.">]
+type WithMultilineTypeHelp =
+    {
+        [<ArgumentHelpText "Input file to process">]
+        InputFile : string
+        [<ArgumentHelpText "Output directory">]
+        OutputDir : string
+        Force : bool
+    }

ConsumePlugin/CatamorphismNoAttribute.fs

@@ -0,0 +1,19 @@
+namespace ConsumePluginNoAttr
+
+type ConstNoAttr<'a> =
+    | Verbatim of 'a
+    | String of string
+
+type PairOpKindNoAttr =
+    | NormalSeq
+    | ThenDoSeq
+
+type TreeNoAttr<'a, 'b> =
+    | Const of ConstNoAttr<'a> * 'b
+    | Pair of TreeNoAttr<'a, 'b> * TreeNoAttr<'a, 'b> * PairOpKindNoAttr
+    | Sequential of TreeNoAttr<'a, 'b> list
+    | Builder of TreeNoAttr<'a, 'b> * TreeBuilderNoAttr<'b, 'a>
+
+and TreeBuilderNoAttr<'b, 'a> =
+    | Child of TreeBuilderNoAttr<'b, 'a>
+    | Parent of TreeNoAttr<'a, 'b>

ConsumePlugin/ConsumePlugin.fsproj

@@ -77,6 +77,13 @@
     <Compile Include="GeneratedCatamorphism.fs">
       <MyriadFile>Catamorphism.fs</MyriadFile>
     </Compile>
+    <Compile Include="CatamorphismNoAttribute.fs" />
+    <Compile Include="GeneratedCatamorphismNoAttribute.fs">
+      <MyriadFile>CatamorphismNoAttribute.fs</MyriadFile>
+      <MyriadParams>
+        <TreeNoAttr>CreateCatamorphism(TreeNoAttrCata)</TreeNoAttr>
+      </MyriadParams>
+    </Compile>
     <Compile Include="FSharpForFunAndProfitCata.fs" />
     <Compile Include="GeneratedFileSystem.fs">
       <MyriadFile>FSharpForFunAndProfitCata.fs</MyriadFile>

ConsumePlugin/GeneratedArgs.fs

@@ -4346,3 +4346,438 @@ module FlagsIntoPositionalArgs'ArgParse =
 
         static member parse (args : string list) : FlagsIntoPositionalArgs' =
             FlagsIntoPositionalArgs'.parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type WithTypeHelp
+[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module WithTypeHelp =
+    type private ParseState_WithTypeHelp =
+        /// 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 option) (args : string list) : WithTypeHelp =
+        let ArgParser_errors = ResizeArray ()
+
+        let helpText () =
+            [
+                "Parse command-line arguments for a basic configuration. This help text appears before the argument list."
+                ""
+
+                (sprintf
+                    "%s  string%s%s"
+                    (sprintf "--%s" "config-file")
+                    ""
+                    (sprintf " : %s" ("The configuration file path")))
+
+                (sprintf "%s  bool%s%s" (sprintf "--%s" "verbose") "" (sprintf " : %s" ("Enable verbose output")))
+                (sprintf "%s  int32%s%s" (sprintf "--%s" "port") "" "")
+            ]
+            |> String.concat "\n"
+
+        let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+        let mutable arg_0 : string option = None
+        let mutable arg_1 : bool option = None
+        let mutable arg_2 : int 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, sprintf "--%s" "port", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_2 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "port")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_2 <- value |> (fun x -> System.Int32.Parse x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else if System.String.Equals (key, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_1 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "verbose")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_1 <- value |> (fun x -> System.Boolean.Parse x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else if
+                System.String.Equals (key, sprintf "--%s" "config-file", System.StringComparison.OrdinalIgnoreCase)
+            then
+                match arg_0 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "config-file")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_0 <- value |> (fun x -> 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, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_1 with
+                | Some x ->
+                    sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "verbose")
+                    |> ArgParser_errors.Add
+
+                    true
+                | None ->
+                    arg_1 <- true |> Some
+                    true
+            else
+                false
+
+        let rec go (state : ParseState_WithTypeHelp) (args : string list) =
+            match args with
+            | [] ->
+                match state with
+                | ParseState_WithTypeHelp.AwaitingKey -> ()
+                | ParseState_WithTypeHelp.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_WithTypeHelp.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_WithTypeHelp.AwaitingValue arg)
+                            else
+                                let key = arg.[0 .. equals - 1]
+                                let value = arg.[equals + 1 ..]
+
+                                match processKeyValue key value with
+                                | Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
+                                | Error x ->
+                                    match x with
+                                    | None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Some msg ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_WithTypeHelp.AwaitingKey args
+                    else
+                        arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                        go ParseState_WithTypeHelp.AwaitingKey args
+                | ParseState_WithTypeHelp.AwaitingValue key ->
+                    match processKeyValue key arg with
+                    | Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
+                    | Error exc ->
+                        if setFlagValue key then
+                            go ParseState_WithTypeHelp.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_WithTypeHelp.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" (sprintf "--%s" "config-file")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        let arg_1 =
+            match arg_1 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "verbose")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        let arg_2 =
+            match arg_2 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "port")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        if 0 = ArgParser_errors.Count then
+            {
+                ConfigFile = arg_0
+                Port = arg_2
+                Verbose = arg_1
+            }
+        else
+            ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+    let parse (args : string list) : WithTypeHelp =
+        parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
+namespace ConsumePlugin
+
+open System
+open System.IO
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type WithMultilineTypeHelp
+[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module WithMultilineTypeHelp =
+    type private ParseState_WithMultilineTypeHelp =
+        /// 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 option) (args : string list) : WithMultilineTypeHelp =
+        let ArgParser_errors = ResizeArray ()
+
+        let helpText () =
+            [
+                "This is a multiline help text example.
+It spans multiple lines to test that multiline strings work correctly.
+You can use this to provide detailed documentation for your argument parser."
+
+                ""
+                (sprintf "%s  string%s%s" (sprintf "--%s" "input-file") "" (sprintf " : %s" ("Input file to process")))
+                (sprintf "%s  string%s%s" (sprintf "--%s" "output-dir") "" (sprintf " : %s" ("Output directory")))
+                (sprintf "%s  bool%s%s" (sprintf "--%s" "force") "" "")
+            ]
+            |> String.concat "\n"
+
+        let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+        let mutable arg_0 : string option = None
+        let mutable arg_1 : string option = None
+        let mutable arg_2 : 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, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_2 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "force")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else if
+                System.String.Equals (key, sprintf "--%s" "output-dir", System.StringComparison.OrdinalIgnoreCase)
+            then
+                match arg_1 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "output-dir")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_1 <- value |> (fun x -> x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else if
+                System.String.Equals (key, sprintf "--%s" "input-file", System.StringComparison.OrdinalIgnoreCase)
+            then
+                match arg_0 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "input-file")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_0 <- value |> (fun x -> 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, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_2 with
+                | Some x ->
+                    sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "force")
+                    |> ArgParser_errors.Add
+
+                    true
+                | None ->
+                    arg_2 <- true |> Some
+                    true
+            else
+                false
+
+        let rec go (state : ParseState_WithMultilineTypeHelp) (args : string list) =
+            match args with
+            | [] ->
+                match state with
+                | ParseState_WithMultilineTypeHelp.AwaitingKey -> ()
+                | ParseState_WithMultilineTypeHelp.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_WithMultilineTypeHelp.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_WithMultilineTypeHelp.AwaitingValue arg)
+                            else
+                                let key = arg.[0 .. equals - 1]
+                                let value = arg.[equals + 1 ..]
+
+                                match processKeyValue key value with
+                                | Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
+                                | Error x ->
+                                    match x with
+                                    | None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Some msg ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_WithMultilineTypeHelp.AwaitingKey args
+                    else
+                        arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                        go ParseState_WithMultilineTypeHelp.AwaitingKey args
+                | ParseState_WithMultilineTypeHelp.AwaitingValue key ->
+                    match processKeyValue key arg with
+                    | Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
+                    | Error exc ->
+                        if setFlagValue key then
+                            go ParseState_WithMultilineTypeHelp.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_WithMultilineTypeHelp.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" (sprintf "--%s" "input-file")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        let arg_1 =
+            match arg_1 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "output-dir")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        let arg_2 =
+            match arg_2 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "force")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        if 0 = ArgParser_errors.Count then
+            {
+                Force = arg_2
+                InputFile = arg_0
+                OutputDir = arg_1
+            }
+        else
+            ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+    let parse (args : string list) : WithMultilineTypeHelp =
+        parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

ConsumePlugin/GeneratedCatamorphismNoAttribute.fs

@@ -0,0 +1,144 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+
+namespace ConsumePluginNoAttr
+
+/// Description of how to combine cases during a fold
+type TreeBuilderNoAttrCataCase<'b, 'a, 'TreeBuilderNoAttr, 'TreeNoAttr> =
+    /// How to operate on the Child case
+    abstract Child : 'TreeBuilderNoAttr -> 'TreeBuilderNoAttr
+    /// How to operate on the Parent case
+    abstract Parent : 'TreeNoAttr -> 'TreeBuilderNoAttr
+
+/// Description of how to combine cases during a fold
+type TreeNoAttrCataCase<'a, 'b, 'TreeBuilderNoAttr, 'TreeNoAttr> =
+    /// How to operate on the Const case
+    abstract Const : ConstNoAttr<'a> -> 'b -> 'TreeNoAttr
+    /// How to operate on the Pair case
+    abstract Pair : 'TreeNoAttr -> 'TreeNoAttr -> PairOpKindNoAttr -> 'TreeNoAttr
+    /// How to operate on the Sequential case
+    abstract Sequential : 'TreeNoAttr list -> 'TreeNoAttr
+    /// How to operate on the Builder case
+    abstract Builder : 'TreeNoAttr -> 'TreeBuilderNoAttr -> 'TreeNoAttr
+
+/// Specifies how to perform a fold (catamorphism) over the type TreeNoAttr and its friends.
+type TreeNoAttrCata<'b, 'a, 'TreeBuilderNoAttr, 'TreeNoAttr> =
+    {
+        /// How to perform a fold (catamorphism) over the type TreeBuilderNoAttr
+        TreeBuilderNoAttr : TreeBuilderNoAttrCataCase<'b, 'a, 'TreeBuilderNoAttr, 'TreeNoAttr>
+        /// How to perform a fold (catamorphism) over the type TreeNoAttr
+        TreeNoAttr : TreeNoAttrCataCase<'a, 'b, 'TreeBuilderNoAttr, 'TreeNoAttr>
+    }
+
+/// Methods to perform a catamorphism over the type TreeNoAttr
+[<RequireQualifiedAccess>]
+module TreeNoAttrCata =
+    [<RequireQualifiedAccess>]
+    type private Instruction<'b, 'a> =
+        | Process__TreeBuilderNoAttr of TreeBuilderNoAttr<'b, 'a>
+        | Process__TreeNoAttr of TreeNoAttr<'a, 'b>
+        | TreeBuilderNoAttr_Child
+        | TreeBuilderNoAttr_Parent
+        | TreeNoAttr_Pair of PairOpKindNoAttr
+        | TreeNoAttr_Sequential of int
+        | TreeNoAttr_Builder
+
+    let private loop
+        (cata : TreeNoAttrCata<'b, 'a, 'TreeBuilderNoAttr, 'TreeNoAttr>)
+        (instructions : ResizeArray<Instruction<'b, 'a>>)
+        =
+        let treeNoAttrStack = ResizeArray<'TreeNoAttr> ()
+        let treeBuilderNoAttrStack = ResizeArray<'TreeBuilderNoAttr> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__TreeBuilderNoAttr x ->
+                match x with
+                | TreeBuilderNoAttr.Child (arg0_0) ->
+                    instructions.Add Instruction.TreeBuilderNoAttr_Child
+                    instructions.Add (Instruction.Process__TreeBuilderNoAttr arg0_0)
+                | TreeBuilderNoAttr.Parent (arg0_0) ->
+                    instructions.Add Instruction.TreeBuilderNoAttr_Parent
+                    instructions.Add (Instruction.Process__TreeNoAttr arg0_0)
+            | Instruction.Process__TreeNoAttr x ->
+                match x with
+                | TreeNoAttr.Const (arg0_0, arg1_0) -> cata.TreeNoAttr.Const arg0_0 arg1_0 |> treeNoAttrStack.Add
+                | TreeNoAttr.Pair (arg0_0, arg1_0, arg2_0) ->
+                    instructions.Add (Instruction.TreeNoAttr_Pair (arg2_0))
+                    instructions.Add (Instruction.Process__TreeNoAttr arg0_0)
+                    instructions.Add (Instruction.Process__TreeNoAttr arg1_0)
+                | TreeNoAttr.Sequential (arg0_0) ->
+                    instructions.Add (Instruction.TreeNoAttr_Sequential ((List.length arg0_0)))
+
+                    for elt in arg0_0 do
+                        instructions.Add (Instruction.Process__TreeNoAttr elt)
+                | TreeNoAttr.Builder (arg0_0, arg1_0) ->
+                    instructions.Add Instruction.TreeNoAttr_Builder
+                    instructions.Add (Instruction.Process__TreeNoAttr arg0_0)
+                    instructions.Add (Instruction.Process__TreeBuilderNoAttr arg1_0)
+            | Instruction.TreeBuilderNoAttr_Child ->
+                let arg0_0 = treeBuilderNoAttrStack.[treeBuilderNoAttrStack.Count - 1]
+                treeBuilderNoAttrStack.RemoveAt (treeBuilderNoAttrStack.Count - 1)
+                cata.TreeBuilderNoAttr.Child arg0_0 |> treeBuilderNoAttrStack.Add
+            | Instruction.TreeBuilderNoAttr_Parent ->
+                let arg0_0 = treeNoAttrStack.[treeNoAttrStack.Count - 1]
+                treeNoAttrStack.RemoveAt (treeNoAttrStack.Count - 1)
+                cata.TreeBuilderNoAttr.Parent arg0_0 |> treeBuilderNoAttrStack.Add
+            | Instruction.TreeNoAttr_Pair arg2_0 ->
+                let arg0_0 = treeNoAttrStack.[treeNoAttrStack.Count - 1]
+                treeNoAttrStack.RemoveAt (treeNoAttrStack.Count - 1)
+                let arg1_0 = treeNoAttrStack.[treeNoAttrStack.Count - 1]
+                treeNoAttrStack.RemoveAt (treeNoAttrStack.Count - 1)
+                cata.TreeNoAttr.Pair arg0_0 arg1_0 arg2_0 |> treeNoAttrStack.Add
+            | Instruction.TreeNoAttr_Sequential arg0_0 ->
+                let arg0_0_len = arg0_0
+
+                let arg0_0 =
+                    seq {
+                        for i = treeNoAttrStack.Count - 1 downto treeNoAttrStack.Count - arg0_0 do
+                            yield treeNoAttrStack.[i]
+                    }
+                    |> Seq.toList
+
+                treeNoAttrStack.RemoveRange (treeNoAttrStack.Count - arg0_0_len, arg0_0_len)
+                cata.TreeNoAttr.Sequential arg0_0 |> treeNoAttrStack.Add
+            | Instruction.TreeNoAttr_Builder ->
+                let arg0_0 = treeNoAttrStack.[treeNoAttrStack.Count - 1]
+                treeNoAttrStack.RemoveAt (treeNoAttrStack.Count - 1)
+                let arg1_0 = treeBuilderNoAttrStack.[treeBuilderNoAttrStack.Count - 1]
+                treeBuilderNoAttrStack.RemoveAt (treeBuilderNoAttrStack.Count - 1)
+                cata.TreeNoAttr.Builder arg0_0 arg1_0 |> treeNoAttrStack.Add
+
+        treeBuilderNoAttrStack, treeNoAttrStack
+
+    /// Execute the catamorphism.
+    let runTreeBuilderNoAttr
+        (cata : TreeNoAttrCata<'b, 'a, 'TreeBuilderNoAttrRet, 'TreeNoAttrRet>)
+        (x : TreeBuilderNoAttr<'b, 'a>)
+        : 'TreeBuilderNoAttrRet
+        =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__TreeBuilderNoAttr x)
+        let treeBuilderNoAttrRetStack, treeNoAttrRetStack = loop cata instructions
+        Seq.exactlyOne treeBuilderNoAttrRetStack
+
+    /// Execute the catamorphism.
+    let runTreeNoAttr
+        (cata : TreeNoAttrCata<'b, 'a, 'TreeBuilderNoAttrRet, 'TreeNoAttrRet>)
+        (x : TreeNoAttr<'a, 'b>)
+        : 'TreeNoAttrRet
+        =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__TreeNoAttr x)
+        let treeBuilderNoAttrRetStack, treeNoAttrRetStack = loop cata instructions
+        Seq.exactlyOne treeNoAttrRetStack

WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs

@@ -62,8 +62,10 @@ type ArgumentDefaultFunctionAttribute () =
 type ArgumentDefaultEnvironmentVariableAttribute (envVar : string) =
     inherit Attribute ()
 
-/// Attribute indicating that this field shall have the given help text, when `--help` is invoked
+/// Attribute indicating that this field or type shall have the given help text, when `--help` is invoked
 /// or when a parse error causes us to print help text.
+/// When applied to a record type, the help text appears at the top of the help output, before the field descriptions.
+/// When applied to a field, the help text appears next to that field's description.
 type ArgumentHelpTextAttribute (helpText : string) =
     inherit Attribute ()
 

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

@@ -1,4 +1,4 @@
-<Project Sdk="Microsoft.NET.Sdk">
+<Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
     <TargetFramework>netstandard2.0</TargetFramework>

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

@@ -444,7 +444,7 @@ Required argument '--exact' received no value"""
         ]
         |> List.map TestCaseData
 
-    [<TestCaseSource(nameof (boolCases))>]
+    [<TestCaseSource(nameof boolCases)>]
     let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
         let getEnvVar (s : string) =
             s |> shouldEqual "CONSUMEPLUGIN_THINGS"
@@ -704,3 +704,87 @@ Required argument '--exact' received no value"""
         // Again, we don't try to detect that the user has missed out the desired argument to `--a`.
         exc.Message
         |> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""
+
+    [<Test>]
+    let ``Type-level help text appears in help output`` () =
+        let getEnvVar (_ : string) = None
+
+        let exc =
+            Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
+
+        exc.Message
+        |> shouldContainText
+            "Parse command-line arguments for a basic configuration. This help text appears before the argument list."
+
+        exc.Message
+        |> shouldContainText "--config-file  string : The configuration file path"
+
+        exc.Message |> shouldContainText "--verbose  bool : Enable verbose output"
+        exc.Message |> shouldContainText "--port  int32"
+
+    [<Test>]
+    let ``Type-level help text appears before field help`` () =
+        let getEnvVar (_ : string) = None
+
+        let exc =
+            Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
+
+        // Verify that the type help appears before the field help
+        let typeHelpIndex =
+            exc.Message.IndexOf "Parse command-line arguments for a basic configuration"
+
+        let fieldHelpIndex = exc.Message.IndexOf "--config-file"
+
+        typeHelpIndex |> shouldBeSmallerThan fieldHelpIndex
+
+    [<Test>]
+    let ``Multiline type-level help text works`` () =
+        let getEnvVar (_ : string) = None
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                WithMultilineTypeHelp.parse' getEnvVar [ "--help" ]
+                |> ignore<WithMultilineTypeHelp>
+            )
+
+        exc.Message |> shouldContainText "This is a multiline help text example."
+
+        exc.Message
+        |> shouldContainText "It spans multiple lines to test that multiline strings work correctly."
+
+        exc.Message
+        |> shouldContainText "You can use this to provide detailed documentation for your argument parser."
+
+        exc.Message |> shouldContainText "--input-file  string : Input file to process"
+        exc.Message |> shouldContainText "--output-dir  string : Output directory"
+        exc.Message |> shouldContainText "--force  bool"
+
+    [<Test>]
+    let ``Type-level help text appears in error messages`` () =
+        let getEnvVar (_ : string) = None
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                WithTypeHelp.parse' getEnvVar [ "--unknown-arg" ; "value" ]
+                |> ignore<WithTypeHelp>
+            )
+
+        // Verify that the type help appears in error messages too
+        exc.Message
+        |> shouldContainText
+            "Parse command-line arguments for a basic configuration. This help text appears before the argument list."
+
+        exc.Message |> shouldContainText "--config-file"
+
+    [<Test>]
+    let ``Types without type-level help still work`` () =
+        let getEnvVar (_ : string) = None
+
+        let exc =
+            Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
+
+        // Should not contain any type-level help, just the field help
+        exc.Message |> shouldContainText "--foo  int32 : This is a foo!"
+        exc.Message |> shouldContainText "--bar  string"
+        // Make sure there's no extra blank line at the beginning
+        exc.Message.StartsWith '\n' |> shouldEqual false

WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestCataGeneratorNoAttr.fs

@@ -0,0 +1,51 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open System.Threading
+open NUnit.Framework
+open FsUnitTyped
+open ConsumePluginNoAttr
+open FsCheck
+
+[<TestFixture>]
+module TestCataGeneratorNoAttr =
+    let idCata<'a, 'b> : TreeNoAttrCata<'a, 'b, _, _> =
+        {
+            TreeNoAttr =
+                { new TreeNoAttrCataCase<_, _, _, _> with
+                    member _.Const x y = Const (x, y)
+                    member _.Pair x y z = Pair (x, y, z)
+                    member _.Sequential xs = Sequential xs
+                    member _.Builder x b = Builder (x, b)
+                }
+            TreeBuilderNoAttr =
+                { new TreeBuilderNoAttrCataCase<_, _, _, _> with
+                    member _.Child x = Child x
+                    member _.Parent x = Parent x
+                }
+        }
+
+    [<Test>]
+    let ``Example`` () =
+        let x =
+            TreeNoAttr.Pair (
+                TreeNoAttr.Const (ConstNoAttr.Verbatim 0, "hi"),
+                TreeNoAttr.Const (ConstNoAttr.String "", "bye"),
+                PairOpKindNoAttr.ThenDoSeq
+            )
+
+        TreeNoAttrCata.runTreeNoAttr idCata x |> shouldEqual x
+
+
+    [<Test>]
+    let ``Cata works`` () =
+        let builderCases = ref 0
+
+        let property (x : TreeNoAttr<int, string>) =
+            match x with
+            | TreeNoAttr.Builder _ -> Interlocked.Increment builderCases |> ignore
+            | _ -> ()
+
+            TreeNoAttrCata.runTreeNoAttr idCata x = x
+
+        Check.QuickThrowOnFailure property
+        builderCases.Value |> shouldBeGreaterThan 10

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

@@ -32,6 +32,7 @@
     <Compile Include="TestCapturingMockGenerator\TestCapturingMockGeneratorNoAttr.fs" />
     <Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
     <Compile Include="TestCataGenerator\TestCataGenerator.fs" />
+    <Compile Include="TestCataGenerator\TestCataGeneratorNoAttr.fs" />
     <Compile Include="TestCataGenerator\TestDirectory.fs" />
     <Compile Include="TestCataGenerator\TestGift.fs" />
     <Compile Include="TestCataGenerator\TestMyList.fs" />
@@ -61,7 +62,7 @@
     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.1" />
     <PackageReference Include="NUnit" Version="4.3.2" />
     <PackageReference Include="NUnit3TestAdapter" Version="5.2.0" />
-    <PackageReference Include="WoofWare.Expect" Version="0.8.4" />
+    <PackageReference Include="WoofWare.Expect" Version="0.8.5" />
   </ItemGroup>
 
   <ItemGroup>

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -769,6 +769,7 @@ module internal ArgParserGenerator =
 
     /// let helpText : string = ...
     let private helpText
+        (typeHelp : SynExpr option)
         (typeName : Ident)
         (positional : ParseFunctionPositional option)
         (args : ParseFunctionNonPositional list)
@@ -850,12 +851,24 @@ module internal ArgParserGenerator =
             |> SynExpr.applyTo helpText
             |> SynExpr.paren
 
-        args
-        |> List.map (toPrintable describeNonPositional)
-        |> fun l ->
-            match positional with
-            | None -> l
-            | Some pos -> l @ [ toPrintable describePositional pos ]
+        let fieldHelp =
+            args
+            |> List.map (toPrintable describeNonPositional)
+            |> fun l ->
+                match positional with
+                | None -> l
+                | Some pos -> l @ [ toPrintable describePositional pos ]
+
+        let allHelp =
+            match typeHelp with
+            | Some helpExpr ->
+                // Prepend type help, followed by blank line, then field help
+                [ helpExpr ; SynExpr.CreateConst "" ] @ fieldHelp
+            | None ->
+                // No type help, just field help
+                fieldHelp
+
+        allHelp
         |> SynExpr.listLiteral
         |> SynExpr.pipeThroughFunction (
             SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst @"\n")
@@ -1560,6 +1573,7 @@ module internal ArgParserGenerator =
 
     /// Takes a single argument, `args : string list`, and returns something of the type indicated by `recordType`.
     let createRecordParse
+        (typeHelpText : SynExpr option)
         (parseState : Ident)
         (flagDus : FlagDu list)
         (ambientRecords : RecordType list)
@@ -1626,7 +1640,7 @@ module internal ArgParserGenerator =
             |> SynExpr.applyTo (SynExpr.CreateConst ())
             |> SynBinding.basic [ argParseErrors ] []
 
-        let helpText = helpText recordType.Name pos nonPos
+        let helpText = helpText typeHelpText recordType.Name pos nonPos
 
         let bindings = errorCollection :: helpText :: bindings
 
@@ -1923,14 +1937,25 @@ module internal ArgParserGenerator =
                 | _ -> None
             )
 
-        let taggedType =
+        let taggedType, typeHelpText =
             match taggedType with
-            | SynTypeDefn.SynTypeDefn (sci,
+            | SynTypeDefn.SynTypeDefn (SynComponentInfo.SynComponentInfo (attributes = attrs) as sci,
                                        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _),
                                        smd,
                                        _,
                                        _,
-                                       _) -> RecordType.OfRecord sci smd access fields
+                                       _) ->
+                let typeHelp =
+                    attrs
+                    |> SynAttributes.toAttrs
+                    |> List.tryPick (fun a ->
+                        match (List.last a.TypeName.LongIdent).idText with
+                        | "ArgumentHelpTextAttribute"
+                        | "ArgumentHelpText" -> Some a.ArgExpr
+                        | _ -> None
+                    )
+
+                RecordType.OfRecord sci smd access fields, typeHelp
             | _ -> failwith "[<ArgParser>] currently only supports being placed on records."
 
         let modAttrs, modName =
@@ -1988,7 +2013,7 @@ module internal ArgParserGenerator =
                 |> SynPat.annotateType (SynType.appPostfix "list" SynType.string)
 
             let parsePrime =
-                createRecordParse parseStateIdent flagDus allRecordTypes taggedType
+                createRecordParse typeHelpText parseStateIdent flagDus allRecordTypes taggedType
                 |> SynBinding.basic
                     [ Ident.create "parse'" ]
                     [

WoofWare.Myriad.Plugins/CataGenerator.fs

@@ -1209,6 +1209,10 @@ type CreateCatamorphismGenerator () =
         member _.ValidInputExtensions = [ ".fs" ]
 
         member _.Generate (context : GeneratorContext) =
+            let targetedTypes =
+                MyriadParamParser.render context.AdditionalParameters
+                |> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
+
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
@@ -1218,17 +1222,26 @@ type CreateCatamorphismGenerator () =
 
             let namespaceAndTypes =
                 types
-                |> List.choose (fun (ns, types) ->
-                    let typeWithAttr =
-                        types
-                        |> List.tryPick (fun ty ->
-                            match SynTypeDefn.getAttribute typeof<CreateCatamorphismAttribute>.Name ty with
-                            | None -> None
-                            | Some attr -> Some (attr.ArgExpr, ty)
-                        )
+                |> List.collect (fun (ns, types) ->
+                    types
+                    |> List.choose (fun typeDef ->
+                        match SynTypeDefn.getAttribute typeof<CreateCatamorphismAttribute>.Name typeDef with
+                        | None ->
+                            let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
 
-                    match typeWithAttr with
-                    | Some taggedType ->
+                            match Map.tryFind name targetedTypes with
+                            | Some desired ->
+                                desired
+                                |> List.tryPick (fun generator ->
+                                    match generator with
+                                    | DesiredGenerator.CreateCatamorphism cataOutputName ->
+                                        Some (SynExpr.CreateConst cataOutputName, typeDef)
+                                    | _ -> None
+                                )
+                            | None -> None
+                        | Some attr -> Some (attr.ArgExpr, typeDef)
+                    )
+                    |> List.map (fun (typeName, taggedType) ->
                         let unions, records, others =
                             (([], [], []), types)
                             ||> List.fold (fun
@@ -1246,8 +1259,8 @@ type CreateCatamorphismGenerator () =
                             failwith
                                 $"Error: all types recursively defined together with a CreateCatamorphism type must be discriminated unions or records. %+A{others}"
 
-                        Some (ns, taggedType, unions, records)
-                    | _ -> None
+                        (ns, (typeName, taggedType), unions, records)
+                    )
                 )
 
             let modules =

WoofWare.Myriad.Plugins/Parameters.fs

@@ -1,11 +1,14 @@
 namespace WoofWare.Myriad.Plugins
 
+open System
+
 type internal DesiredGenerator =
     | InterfaceMock of isInternal : bool option
     | CapturingInterfaceMock of isInternal : bool option
     | JsonParse of extensionMethod : bool option
     | JsonSerialize of extensionMethod : bool option
     | HttpClient of extensionMethod : bool option
+    | CreateCatamorphism of typeName : string
 
     static member Parse (s : string) =
         match s with
@@ -24,4 +27,10 @@ type internal DesiredGenerator =
         | "HttpClient" -> DesiredGenerator.HttpClient None
         | "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true)
         | "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false)
-        | _ -> failwith $"Failed to parse as a generator specification: %s{s}"
+        | _ ->
+            let prefix = "CreateCatamorphism("
+
+            if s.StartsWith (prefix, StringComparison.Ordinal) && s.EndsWith ')' then
+                DesiredGenerator.CreateCatamorphism (s.Substring (prefix.Length, s.Length - prefix.Length - 1))
+            else
+                failwith $"Failed to parse as a generator specification: %s{s}"

flake.lock

@@ -20,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1763191728,
-        "narHash": "sha256-esRhOS0APE6k40Hs/jjReXg+rx+J5LkWw7cuWFKlwYA=",
+        "lastModified": 1764138170,
+        "narHash": "sha256-2bCmfCUZyi2yj9FFXYKwsDiaZmizN75cLhI/eWmf3tk=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "1d4c88323ac36805d09657d13a5273aea1b34f0c",
+        "rev": "bb813de6d2241bcb1b5af2d3059f560c66329967",
         "type": "github"
       },
       "original": {

nix/deps.json

@@ -386,8 +386,8 @@
   },
   {
     "pname": "WoofWare.Expect",
-    "version": "0.8.4",
-    "hash": "sha256-UI7f2nt4g4Gg1Ke/IChrA4fpVOYAChXpvR6zkKfkmzE="
+    "version": "0.8.5",
+    "hash": "sha256-rMlkk1osadQYwxmb0KAHqsB51hinTf7NzI0zyovpx04="
   },
   {
     "pname": "WoofWare.NUnitTestRunner",