Bump fantomas from 6.3.0 to 6.3.3 (#120)

* Bump fantomas from 6.3.0 to 6.3.3

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.0 to 6.3.3.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.0...v6.3.3)

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

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

* Fix dep

---------

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

.config/dotnet-tools.json

@@ -3,16 +3,16 @@
   "isRoot": true,
   "tools": {
     "fantomas": {
-      "version": "6.3.0-alpha-007",
+      "version": "6.3.3",
       "commands": [
         "fantomas"
       ]
     },
     "fsharp-analyzers": {
-      "version": "0.24.0",
+      "version": "0.25.0",
       "commands": [
         "fsharp-analyzers"
       ]
     }
   }
-}
+}

.editorconfig

@@ -2,7 +2,6 @@ root=true
 
 [*]
 charset=utf-8
-end_of_line=crlf
 trim_trailing_whitespace=true
 insert_final_newline=true
 indent_style=space

.gitattributes

@@ -1,5 +1,5 @@
-* eol=auto
-*.sh text eol=lf
-*.yaml text
-*.nix text eol=lf
-hooks/pre-push text eol=lf
+* eol=auto
+*.sh text eol=lf
+*.yaml text
+*.nix text eol=lf
+hooks/pre-push text eol=lf

.github/workflows/dotnet.yaml

@@ -28,7 +28,7 @@ jobs:
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
-      uses: cachix/install-nix-action@v25
+      uses: cachix/install-nix-action@v26
       with:
         extra_nix_config: |
           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -49,7 +49,7 @@ jobs:
         with:
           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -58,7 +58,7 @@ jobs:
       - name: Build project
         run: nix develop --command dotnet build ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
       - name: Run analyzers
-        run: nix run .#fsharp-analyzers -- --project ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj --analyzers-path ./.analyzerpackages/g-research.fsharp.analyzers/0.8.0/ --verbosity detailed --report ./analysis.sarif --treat-as-error GRA-STRING-001 GRA-STRING-002 GRA-STRING-003 GRA-UNIONCASE-001 GRA-INTERPOLATED-001 GRA-TYPE-ANNOTATE-001 GRA-VIRTUALCALL-001 GRA-IMMUTABLECOLLECTIONEQUALITY-001 GRA-JSONOPTS-001 GRA-LOGARGFUNCFULLAPP-001 GRA-DISPBEFOREASYNC-001 --exclude-analyzers PartialAppAnalyzer
+        run: nix run .#fsharp-analyzers -- --project ./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj --analyzers-path ./.analyzerpackages/g-research.fsharp.analyzers/*/ --verbosity detailed --report ./analysis.sarif --treat-as-error GRA-STRING-001 GRA-STRING-002 GRA-STRING-003 GRA-UNIONCASE-001 GRA-INTERPOLATED-001 GRA-TYPE-ANNOTATE-001 GRA-VIRTUALCALL-001 GRA-IMMUTABLECOLLECTIONEQUALITY-001 GRA-JSONOPTS-001 GRA-LOGARGFUNCFULLAPP-001 GRA-DISPBEFOREASYNC-001 --exclude-analyzers PartialAppAnalyzer
 
   build-nix:
     runs-on: ubuntu-latest
@@ -66,7 +66,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -79,7 +79,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -92,7 +92,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -105,7 +105,7 @@ jobs:
     steps:
       - uses: actions/checkout@master
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -118,7 +118,7 @@ jobs:
     steps:
       - uses: actions/checkout@master
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -132,7 +132,7 @@ jobs:
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
-      uses: cachix/install-nix-action@v25
+      uses: cachix/install-nix-action@v26
       with:
         extra_nix_config: |
           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -188,7 +188,7 @@ jobs:
     steps:
       - uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v26
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -206,3 +206,25 @@ jobs:
           path: packed-attribute
       - name: Publish to NuGet (attribute)
         run: nix develop --command dotnet nuget push "packed-attribute/WoofWare.Myriad.Plugins.Attributes.*.nupkg" --api-key ${{ secrets.NUGET_API_KEY }} --source https://api.nuget.org/v3/index.json --skip-duplicate
+
+  github-release-plugin:
+    runs-on: ubuntu-latest
+    if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
+    needs: [all-required-checks-complete]
+    environment: main-deploy
+    permissions:
+      contents: write
+    steps:
+      - uses: actions/checkout@v4
+      - name: Download NuGet artifact (plugin)
+        uses: actions/download-artifact@v4
+        with:
+          name: nuget-package-plugin
+      - name: Download NuGet artifact (attribute)
+        uses: actions/download-artifact@v4
+        with:
+          name: nuget-package-attribute
+      - name: Tag and release plugin
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+        run: sh .github/workflows/tag.sh

.github/workflows/tag.sh

@@ -0,0 +1,17 @@
+#!/bin/sh
+
+find . -maxdepth 1 -type f -name '*.nupkg' -exec sh -c 'tag=$(basename "$1" .nupkg); git tag "$tag"; git push origin "$tag"' shell {} \;
+
+export TAG
+TAG=$(find . -maxdepth 1 -type f -name 'WoofWare.Myriad.Plugins.*.nupkg' -exec sh -c 'basename "$1" .nupkg' shell {} \; | grep -v Attributes)
+
+case "$TAG" in
+  *"
+"*)
+    echo "Error: TAG contains a newline; multiple plugins found."
+    exit 1
+    ;;
+esac
+
+# target_commitish empty indicates the repo default branch
+curl -L -X POST -H "Accept: application/vnd.github+json" -H "Authorization: Bearer $GITHUB_TOKEN" -H "X-GitHub-Api-Version: 2022-11-28" https://api.github.com/repos/Smaug123/WoofWare.Myriad/releases -d '{"tag_name":"'"$TAG"'","target_commitish":"","name":"'"$TAG"'","draft":false,"prerelease":false,"generate_release_notes":false}'

ConsumePlugin/Catamorphism.fs

@@ -0,0 +1,22 @@
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+type Const<'a> =
+    | Verbatim of 'a
+    | String of string
+
+type PairOpKind =
+    | NormalSeq
+    | ThenDoSeq
+
+[<CreateCatamorphism "TreeCata">]
+type Tree<'a, 'b> =
+    | Const of Const<'a> * 'b
+    | Pair of Tree<'a, 'b> * Tree<'a, 'b> * PairOpKind
+    | Sequential of Tree<'a, 'b> list
+    | Builder of Tree<'a, 'b> * TreeBuilder<'b, 'a>
+
+and TreeBuilder<'b, 'a> =
+    | Child of TreeBuilder<'b, 'a>
+    | Parent of Tree<'a, 'b>

ConsumePlugin/ConsumePlugin.fsproj

@@ -39,6 +39,18 @@
     <Compile Include="GeneratedSerde.fs">
       <MyriadFile>SerializationAndDeserialization.fs</MyriadFile>
     </Compile>
+    <Compile Include="Catamorphism.fs" />
+    <Compile Include="GeneratedCatamorphism.fs">
+      <MyriadFile>Catamorphism.fs</MyriadFile>
+    </Compile>
+    <Compile Include="FSharpForFunAndProfitCata.fs" />
+    <Compile Include="GeneratedFileSystem.fs">
+      <MyriadFile>FSharpForFunAndProfitCata.fs</MyriadFile>
+    </Compile>
+    <Compile Include="List.fs" />
+    <Compile Include="ListCata.fs">
+      <MyriadFile>List.fs</MyriadFile>
+    </Compile>
   </ItemGroup>
 
   <ItemGroup>

ConsumePlugin/FSharpForFunAndProfitCata.fs

@@ -0,0 +1,52 @@
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+type File =
+    {
+        Name : string
+        FileSize : int
+    }
+
+type Directory =
+    {
+        Name : string
+        DirSize : int
+        Contents : FileSystemItem list
+    }
+
+and [<CreateCatamorphism "FileSystemCata">] FileSystemItem =
+    | Directory of Directory
+    | File of File
+
+type Book =
+    {
+        title : string
+        price : decimal
+    }
+
+type ChocolateType =
+    | Dark
+    | Milk
+    | SeventyPercent
+
+type Chocolate =
+    {
+        chocType : ChocolateType
+        price : decimal
+    }
+
+    override this.ToString () = this.chocType.ToString ()
+
+type WrappingPaperStyle =
+    | HappyBirthday
+    | HappyHolidays
+    | SolidColor
+
+[<CreateCatamorphism "GiftCata">]
+type Gift =
+    | Book of Book
+    | Chocolate of Chocolate
+    | Wrapped of Gift * WrappingPaperStyle
+    | Boxed of Gift
+    | WithACard of Gift * message : string

ConsumePlugin/GeneratedCatamorphism.fs

@@ -0,0 +1,138 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+/// Description of how to combine cases during a fold
+type TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree> =
+    /// How to operate on the Child case
+    abstract Child : 'TreeBuilder -> 'TreeBuilder
+    /// How to operate on the Parent case
+    abstract Parent : 'Tree -> 'TreeBuilder
+
+/// Description of how to combine cases during a fold
+type TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree> =
+    /// How to operate on the Const case
+    abstract Const : Const<'a> -> 'b -> 'Tree
+    /// How to operate on the Pair case
+    abstract Pair : 'Tree -> 'Tree -> PairOpKind -> 'Tree
+    /// How to operate on the Sequential case
+    abstract Sequential : 'Tree list -> 'Tree
+    /// How to operate on the Builder case
+    abstract Builder : 'Tree -> 'TreeBuilder -> 'Tree
+
+/// Specifies how to perform a fold (catamorphism) over the type Tree and its friends.
+type TreeCata<'b, 'a, 'TreeBuilder, 'Tree> =
+    {
+        /// How to perform a fold (catamorphism) over the type TreeBuilder
+        TreeBuilder : TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree>
+        /// How to perform a fold (catamorphism) over the type Tree
+        Tree : TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree>
+    }
+
+/// Methods to perform a catamorphism over the type Tree
+[<RequireQualifiedAccess>]
+module TreeCata =
+    [<RequireQualifiedAccess>]
+    type private Instruction<'b, 'a> =
+        | Process__TreeBuilder of TreeBuilder<'b, 'a>
+        | Process__Tree of Tree<'a, 'b>
+        | TreeBuilder_Child
+        | TreeBuilder_Parent
+        | Tree_Pair of PairOpKind
+        | Tree_Sequential of int
+        | Tree_Builder
+
+    let private loop (cata : TreeCata<'b, 'a, 'TreeBuilder, 'Tree>) (instructions : ResizeArray<Instruction<'b, 'a>>) =
+        let treeStack = ResizeArray<'Tree> ()
+        let treeBuilderStack = ResizeArray<'TreeBuilder> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__TreeBuilder x ->
+                match x with
+                | TreeBuilder.Child (arg0_0) ->
+                    instructions.Add Instruction.TreeBuilder_Child
+                    instructions.Add (Instruction.Process__TreeBuilder arg0_0)
+                | TreeBuilder.Parent (arg0_0) ->
+                    instructions.Add Instruction.TreeBuilder_Parent
+                    instructions.Add (Instruction.Process__Tree arg0_0)
+            | Instruction.Process__Tree x ->
+                match x with
+                | Tree.Const (arg0_0, arg1_0) -> cata.Tree.Const arg0_0 arg1_0 |> treeStack.Add
+                | Tree.Pair (arg0_0, arg1_0, arg2_0) ->
+                    instructions.Add (Instruction.Tree_Pair (arg2_0))
+                    instructions.Add (Instruction.Process__Tree arg0_0)
+                    instructions.Add (Instruction.Process__Tree arg1_0)
+                | Tree.Sequential (arg0_0) ->
+                    instructions.Add (Instruction.Tree_Sequential ((List.length arg0_0)))
+
+                    for elt in arg0_0 do
+                        instructions.Add (Instruction.Process__Tree elt)
+                | Tree.Builder (arg0_0, arg1_0) ->
+                    instructions.Add Instruction.Tree_Builder
+                    instructions.Add (Instruction.Process__Tree arg0_0)
+                    instructions.Add (Instruction.Process__TreeBuilder arg1_0)
+            | Instruction.TreeBuilder_Child ->
+                let arg0_0 = treeBuilderStack.[treeBuilderStack.Count - 1]
+                treeBuilderStack.RemoveAt (treeBuilderStack.Count - 1)
+                cata.TreeBuilder.Child arg0_0 |> treeBuilderStack.Add
+            | Instruction.TreeBuilder_Parent ->
+                let arg0_0 = treeStack.[treeStack.Count - 1]
+                treeStack.RemoveAt (treeStack.Count - 1)
+                cata.TreeBuilder.Parent arg0_0 |> treeBuilderStack.Add
+            | Instruction.Tree_Pair (arg2_0) ->
+                let arg0_0 = treeStack.[treeStack.Count - 1]
+                treeStack.RemoveAt (treeStack.Count - 1)
+                let arg1_0 = treeStack.[treeStack.Count - 1]
+                treeStack.RemoveAt (treeStack.Count - 1)
+                cata.Tree.Pair arg0_0 arg1_0 arg2_0 |> treeStack.Add
+            | Instruction.Tree_Sequential (arg0_0) ->
+                let arg0_0_len = arg0_0
+
+                let arg0_0 =
+                    seq {
+                        for i = treeStack.Count - 1 downto treeStack.Count - arg0_0 do
+                            yield treeStack.[i]
+                    }
+                    |> Seq.toList
+
+                treeStack.RemoveRange (treeStack.Count - arg0_0_len, arg0_0_len)
+                cata.Tree.Sequential arg0_0 |> treeStack.Add
+            | Instruction.Tree_Builder ->
+                let arg0_0 = treeStack.[treeStack.Count - 1]
+                treeStack.RemoveAt (treeStack.Count - 1)
+                let arg1_0 = treeBuilderStack.[treeBuilderStack.Count - 1]
+                treeBuilderStack.RemoveAt (treeBuilderStack.Count - 1)
+                cata.Tree.Builder arg0_0 arg1_0 |> treeStack.Add
+
+        treeBuilderStack, treeStack
+
+    /// Execute the catamorphism.
+    let runTreeBuilder
+        (cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>)
+        (x : TreeBuilder<'b, 'a>)
+        : 'TreeBuilderRet
+        =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__TreeBuilder x)
+        let treeBuilderRetStack, treeRetStack = loop cata instructions
+        Seq.exactlyOne treeBuilderRetStack
+
+    /// Execute the catamorphism.
+    let runTree (cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>) (x : Tree<'a, 'b>) : 'TreeRet =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__Tree x)
+        let treeBuilderRetStack, treeRetStack = loop cata instructions
+        Seq.exactlyOne treeRetStack

ConsumePlugin/GeneratedFileSystem.fs

@@ -0,0 +1,152 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+/// Description of how to combine cases during a fold
+type FileSystemItemCataCase<'FileSystemItem> =
+    /// How to operate on the Directory case
+    abstract Directory : name : string -> dirSize : int -> contents : 'FileSystemItem list -> 'FileSystemItem
+    /// How to operate on the File case
+    abstract File : File -> 'FileSystemItem
+
+/// Specifies how to perform a fold (catamorphism) over the type FileSystemItem and its friends.
+type FileSystemCata<'FileSystemItem> =
+    {
+        /// How to perform a fold (catamorphism) over the type FileSystemItem
+        FileSystemItem : FileSystemItemCataCase<'FileSystemItem>
+    }
+
+/// Methods to perform a catamorphism over the type FileSystemItem
+[<RequireQualifiedAccess>]
+module FileSystemItemCata =
+    [<RequireQualifiedAccess>]
+    type private Instruction =
+        | Process__FileSystemItem of FileSystemItem
+        | FileSystemItem_Directory of string * int * int
+
+    let private loop (cata : FileSystemCata<'FileSystemItem>) (instructions : ResizeArray<Instruction>) =
+        let fileSystemItemStack = ResizeArray<'FileSystemItem> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__FileSystemItem x ->
+                match x with
+                | FileSystemItem.Directory ({
+                                                Name = name
+                                                DirSize = dirSize
+                                                Contents = contents
+                                            }) ->
+                    instructions.Add (Instruction.FileSystemItem_Directory (name, dirSize, (List.length contents)))
+
+                    for elt in contents do
+                        instructions.Add (Instruction.Process__FileSystemItem elt)
+                | FileSystemItem.File (arg0_0) -> cata.FileSystemItem.File arg0_0 |> fileSystemItemStack.Add
+            | Instruction.FileSystemItem_Directory (name, dirSize, contents) ->
+                let contents_len = contents
+
+                let contents =
+                    seq {
+                        for i = fileSystemItemStack.Count - 1 downto fileSystemItemStack.Count - contents do
+                            yield fileSystemItemStack.[i]
+                    }
+                    |> Seq.toList
+
+                fileSystemItemStack.RemoveRange (fileSystemItemStack.Count - contents_len, contents_len)
+                cata.FileSystemItem.Directory name dirSize contents |> fileSystemItemStack.Add
+
+        fileSystemItemStack
+
+    /// Execute the catamorphism.
+    let runFileSystemItem (cata : FileSystemCata<'FileSystemItemRet>) (x : FileSystemItem) : 'FileSystemItemRet =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__FileSystemItem x)
+        let fileSystemItemRetStack = loop cata instructions
+        Seq.exactlyOne fileSystemItemRetStack
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+/// Description of how to combine cases during a fold
+type GiftCataCase<'Gift> =
+    /// How to operate on the Book case
+    abstract Book : Book -> 'Gift
+    /// How to operate on the Chocolate case
+    abstract Chocolate : Chocolate -> 'Gift
+    /// How to operate on the Wrapped case
+    abstract Wrapped : 'Gift -> WrappingPaperStyle -> 'Gift
+    /// How to operate on the Boxed case
+    abstract Boxed : 'Gift -> 'Gift
+    /// How to operate on the WithACard case
+    abstract WithACard : 'Gift -> message : string -> 'Gift
+
+/// Specifies how to perform a fold (catamorphism) over the type Gift and its friends.
+type GiftCata<'Gift> =
+    {
+        /// How to perform a fold (catamorphism) over the type Gift
+        Gift : GiftCataCase<'Gift>
+    }
+
+/// Methods to perform a catamorphism over the type Gift
+[<RequireQualifiedAccess>]
+module GiftCata =
+    [<RequireQualifiedAccess>]
+    type private Instruction =
+        | Process__Gift of Gift
+        | Gift_Wrapped of WrappingPaperStyle
+        | Gift_Boxed
+        | Gift_WithACard of string
+
+    let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) =
+        let giftStack = ResizeArray<'Gift> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__Gift x ->
+                match x with
+                | Gift.Book (arg0_0) -> cata.Gift.Book arg0_0 |> giftStack.Add
+                | Gift.Chocolate (arg0_0) -> cata.Gift.Chocolate arg0_0 |> giftStack.Add
+                | Gift.Wrapped (arg0_0, arg1_0) ->
+                    instructions.Add (Instruction.Gift_Wrapped (arg1_0))
+                    instructions.Add (Instruction.Process__Gift arg0_0)
+                | Gift.Boxed (arg0_0) ->
+                    instructions.Add Instruction.Gift_Boxed
+                    instructions.Add (Instruction.Process__Gift arg0_0)
+                | Gift.WithACard (arg0_0, message) ->
+                    instructions.Add (Instruction.Gift_WithACard (message))
+                    instructions.Add (Instruction.Process__Gift arg0_0)
+            | Instruction.Gift_Wrapped (arg1_0) ->
+                let arg0_0 = giftStack.[giftStack.Count - 1]
+                giftStack.RemoveAt (giftStack.Count - 1)
+                cata.Gift.Wrapped arg0_0 arg1_0 |> giftStack.Add
+            | Instruction.Gift_Boxed ->
+                let arg0_0 = giftStack.[giftStack.Count - 1]
+                giftStack.RemoveAt (giftStack.Count - 1)
+                cata.Gift.Boxed arg0_0 |> giftStack.Add
+            | Instruction.Gift_WithACard (message) ->
+                let arg0_0 = giftStack.[giftStack.Count - 1]
+                giftStack.RemoveAt (giftStack.Count - 1)
+                cata.Gift.WithACard arg0_0 message |> giftStack.Add
+
+        giftStack
+
+    /// Execute the catamorphism.
+    let runGift (cata : GiftCata<'GiftRet>) (x : Gift) : 'GiftRet =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__Gift x)
+        let giftRetStack = loop cata instructions
+        Seq.exactlyOne giftRetStack

ConsumePlugin/List.fs

@@ -0,0 +1,19 @@
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+[<CreateCatamorphism "MyListCata">]
+type MyList<'a> =
+    | Nil
+    | Cons of ConsCase<'a>
+
+and ConsCase<'a> =
+    {
+        Head : 'a
+        Tail : MyList<'a>
+    }
+
+[<CreateCatamorphism "MyList2Cata">]
+type MyList2<'a> =
+    | Nil
+    | Cons of 'a * MyList2<'a>

ConsumePlugin/ListCata.fs

@@ -0,0 +1,118 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+/// Description of how to combine cases during a fold
+type MyListCataCase<'a, 'MyList> =
+    /// How to operate on the Nil case
+    abstract Nil : 'MyList
+    /// How to operate on the Cons case
+    abstract Cons : head : 'a -> tail : 'MyList -> 'MyList
+
+/// Specifies how to perform a fold (catamorphism) over the type MyList and its friends.
+type MyListCata<'a, 'MyList> =
+    {
+        /// How to perform a fold (catamorphism) over the type MyList
+        MyList : MyListCataCase<'a, 'MyList>
+    }
+
+/// Methods to perform a catamorphism over the type MyList
+[<RequireQualifiedAccess>]
+module MyListCata =
+    [<RequireQualifiedAccess>]
+    type private Instruction<'a> =
+        | Process__MyList of MyList<'a>
+        | MyList_Cons of 'a
+
+    let private loop (cata : MyListCata<'a, 'MyList>) (instructions : ResizeArray<Instruction<'a>>) =
+        let myListStack = ResizeArray<'MyList> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__MyList x ->
+                match x with
+                | MyList.Nil -> cata.MyList.Nil |> myListStack.Add
+                | MyList.Cons ({
+                                   Head = head
+                                   Tail = tail
+                               }) ->
+                    instructions.Add (Instruction.MyList_Cons (head))
+                    instructions.Add (Instruction.Process__MyList tail)
+            | Instruction.MyList_Cons (head) ->
+                let tail = myListStack.[myListStack.Count - 1]
+                myListStack.RemoveAt (myListStack.Count - 1)
+                cata.MyList.Cons head tail |> myListStack.Add
+
+        myListStack
+
+    /// Execute the catamorphism.
+    let runMyList (cata : MyListCata<'a, 'MyListRet>) (x : MyList<'a>) : 'MyListRet =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__MyList x)
+        let myListRetStack = loop cata instructions
+        Seq.exactlyOne myListRetStack
+namespace ConsumePlugin
+
+open WoofWare.Myriad.Plugins
+
+/// Description of how to combine cases during a fold
+type MyList2CataCase<'a, 'MyList2> =
+    /// How to operate on the Nil case
+    abstract Nil : 'MyList2
+    /// How to operate on the Cons case
+    abstract Cons : 'a -> 'MyList2 -> 'MyList2
+
+/// Specifies how to perform a fold (catamorphism) over the type MyList2 and its friends.
+type MyList2Cata<'a, 'MyList2> =
+    {
+        /// How to perform a fold (catamorphism) over the type MyList2
+        MyList2 : MyList2CataCase<'a, 'MyList2>
+    }
+
+/// Methods to perform a catamorphism over the type MyList2
+[<RequireQualifiedAccess>]
+module MyList2Cata =
+    [<RequireQualifiedAccess>]
+    type private Instruction<'a> =
+        | Process__MyList2 of MyList2<'a>
+        | MyList2_Cons of 'a
+
+    let private loop (cata : MyList2Cata<'a, 'MyList2>) (instructions : ResizeArray<Instruction<'a>>) =
+        let myList2Stack = ResizeArray<'MyList2> ()
+
+        while instructions.Count > 0 do
+            let currentInstruction = instructions.[instructions.Count - 1]
+            instructions.RemoveAt (instructions.Count - 1)
+
+            match currentInstruction with
+            | Instruction.Process__MyList2 x ->
+                match x with
+                | MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
+                | MyList2.Cons (arg0_0, arg1_0) ->
+                    instructions.Add (Instruction.MyList2_Cons (arg0_0))
+                    instructions.Add (Instruction.Process__MyList2 arg1_0)
+            | Instruction.MyList2_Cons (arg0_0) ->
+                let arg1_0 = myList2Stack.[myList2Stack.Count - 1]
+                myList2Stack.RemoveAt (myList2Stack.Count - 1)
+                cata.MyList2.Cons arg0_0 arg1_0 |> myList2Stack.Add
+
+        myList2Stack
+
+    /// Execute the catamorphism.
+    let runMyList2 (cata : MyList2Cata<'a, 'MyList2Ret>) (x : MyList2<'a>) : 'MyList2Ret =
+        let instructions = ResizeArray ()
+        instructions.Add (Instruction.Process__MyList2 x)
+        let myList2RetStack = loop cata instructions
+        Seq.exactlyOne myList2RetStack

README.md

@@ -23,6 +23,7 @@ Currently implemented:
 * `RemoveOptions` (to strip `option` modifiers from a type).
 * `HttpClient` (to stamp out a [RestEase](https://github.com/canton7/RestEase)-style HTTP client).
 * `GenerateMock` (to stamp out a record type corresponding to an interface).
+* `CreateCatamorphism` (to stamp out a non-stack-overflowing [catamorphism](https://fsharpforfunandprofit.com/posts/recursive-types-and-folds/) for a discriminated union).
 
 ## `JsonParse`
 
@@ -326,6 +327,82 @@ thereby allowing the programmer to use F#'s record-update syntax.
 
 * You may supply an `isInternal : bool` argument to the attribute. By default, we make the resulting record type at most internal (never public), since this is intended only to be used in tests; but you can instead make it public with `[<GenerateMock false>]`.
 
+## `CreateCatamorphism`
+
+Takes a collection of mutually recursive discriminated unions:
+
+```fsharp
+[<CreateCatamorphism "MyCata">]
+type Expr =
+    | Const of Const
+    | Pair of Expr * Expr * PairOpKind
+    | Sequential of Expr list
+    | Builder of Expr * ExprBuilder
+
+and ExprBuilder =
+    | Child of ExprBuilder
+    | Parent of Expr
+```
+
+and stamps out a type like this:
+```fsharp
+type ExprCata<'Expr, 'ExprBuilder> =
+    abstract Const : Const -> 'Expr
+    abstract Pair : 'Expr -> 'Expr -> PairOpKind -> 'Expr
+    abstract Sequential : 'Expr list -> 'Expr
+    abstract Builder : 'Expr -> 'ExprBuilder -> 'Expr
+
+type ExprBuilderCata<'Expr, 'ExprBuilder> =
+    abstract Child : 'ExprBuilder -> 'ExprBuilder
+    abstract Parent : 'Expr -> 'ExprBuilder
+
+type MyCata<'Expr, 'ExprBuilder> =
+    {
+        Expr : ExprCata<'Expr, 'ExprBuilder>
+        ExprBuilder : ExprBuilderCata<'Expr, 'ExprBuilder>
+    }
+
+[<RequireQualifiedAccess>]
+module ExprCata =
+    let runExpr (cata : MyCata<'ExprRet, 'ExprBuilderRet>) (x : Expr) : 'ExprRet =
+        failwith "this is implemented"
+
+    let runExprBuilder (cata : MyCata<'ExprRet, 'ExprBuilderRet>) (x : ExprBuilder) : 'ExprBuilderRet =
+        failwith "this is implemented"
+```
+
+### What's the point?
+Recursing over a tree is not easy to get right, especially if you want to avoid stack overflows.
+Instead of writing the recursion many times, it's better to do it once,
+and then each time you only plug in what you want to do.
+
+### Features
+
+* Mutually recursive DUs are supported (as in the example above).
+  Every DU in a recursive `type Foo... and Bar...` knot will be given an appropriate cata, as long as any one of those DUs has the `[<CreateCatamorphism>]` attribute.
+* There is *limited* support for records and for lists.
+* There is *extremely brittle* support for generics in the DUs you are cata'ing over.
+  It is based on the names of the generic parameters, so you must ensure that generic parameters with the same name have the same meaning across the various cases in your recursive knot of DUs.
+  (If you overstep the bounds of what this generator can do, you will get compile-time errors, e.g. with generics being constrained to each other's values.)
+  See the [List tests](./WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList2.fs) for an example, where we re-implement `FSharpList<'a>`.
+
+### Limitations
+
+**I am not at all convinced of the correctness of this generator**, and I know it is very incomplete (in the sense that there are many possible DUs you could write for which the generator will bail out).
+I *strongly* recommend implementing the identity catamorphism for your type and using property-based tests ([as I do](./WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestDirectory.fs)) to assert that the correct thing happens.
+Feel free to raise GitHub issues with code I can copy-paste to reproduce a case where the wrong thing happens (though I can't promise to look at them).
+
+* This is a particularly half-baked generator which has so far seen no real-world use.
+  It likely has a bunch of [80/20](https://en.wikipedia.org/wiki/Pareto_principle) low-hanging fruit remaining, but it also likely has impossible problems to solve which I don't know about yet.
+* Only a very few kinds of DU field are currently implemented.
+  For example, this generator can't see through an interface (e.g. the kind of interface one would use to implement the [crate pattern](https://www.patrickstevens.co.uk/posts/2021-10-19-crates/) to represent a [GADT](https://en.wikipedia.org/wiki/Generalized_algebraic_data_type)),
+  so the generated cata will simply grant you access to the interface (rather than attempting to descend into it to discover recursive references).
+  You can't nest lists deeply. All sorts of other cases are unaddressed.
+* This generator does not try to solve the "exponential diamond dependency" problem.
+  If you have a case of the form `type Expr = | Branch of Expr * Expr`, the cata will walk into both `Expr`s separately.
+  If the `Expr`s happen to be equal, the cata will nevertheless traverse them individually (that is, it will traverse the same `Expr` twice).
+  Your type may represent a [DAG](https://en.wikipedia.org/wiki/Directed_acyclic_graph), but we will always effectively expand it into a tree of paths and operate on each of the exponentially-many paths.
+
 # Detailed examples
 
 See the tests.

WoofWare.Myriad.Plugins.Attributes/Attributes.fs

@@ -62,3 +62,11 @@ type JsonParseAttribute (isExtensionMethod : bool) =
 /// i.e. to stamp out HTTP REST clients from interfaces defining the API.
 type HttpClientAttribute () =
     inherit Attribute ()
+
+/// Attribute indicating a DU type to which the "create catamorphism" Myriad
+/// generator should apply during build.
+/// Supply the `typeName` for the name of the record type we will generate, which contains
+/// all the catas required; for example, "MyThing" would generate:
+/// type MyThing<'a, 'b> = { Du1 : Du1Cata<'a, 'b> ; Du2 : Du2Cata<'a, 'b> }.
+type CreateCatamorphismAttribute (typeName : string) =
+    inherit Attribute ()

WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt

@@ -1,3 +1,5 @@
+WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
+WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: bool
 WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit

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

@@ -12,9 +12,9 @@
     </ItemGroup>
 
     <ItemGroup>
-        <PackageReference Include="ApiSurface" Version="4.0.28" />
+        <PackageReference Include="ApiSurface" Version="4.0.33" />
         <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.9.0"/>
-        <PackageReference Include="NUnit" Version="3.13.3"/>
+        <PackageReference Include="NUnit" Version="4.1.0"/>
         <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
     </ItemGroup>
 

WoofWare.Myriad.Plugins.Attributes/version.json

@@ -1,7 +1,7 @@
 {
-  "version": "2.1",
+  "version": "2.2",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],
   "pathFilters": null
-}
+}

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

@@ -0,0 +1,47 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open System.Threading
+open NUnit.Framework
+open FsUnitTyped
+open ConsumePlugin
+open FsCheck
+
+[<TestFixture>]
+module TestCataGenerator =
+    let idCata<'a, 'b> : TreeCata<'a, 'b, _, _> =
+        {
+            Tree =
+                { new TreeCataCase<_, _, _, _> 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)
+                }
+            TreeBuilder =
+                { new TreeBuilderCataCase<_, _, _, _> with
+                    member _.Child x = Child x
+                    member _.Parent x = Parent x
+                }
+        }
+
+    [<Test>]
+    let ``Example`` () =
+        let x =
+            Tree.Pair (Tree.Const (Const.Verbatim 0, "hi"), Tree.Const (Const.String "", "bye"), PairOpKind.ThenDoSeq)
+
+        TreeCata.runTree idCata x |> shouldEqual x
+
+
+    [<Test>]
+    let ``Cata works`` () =
+        let builderCases = ref 0
+
+        let property (x : Tree<int, string>) =
+            match x with
+            | Tree.Builder _ -> Interlocked.Increment builderCases |> ignore
+            | _ -> ()
+
+            TreeCata.runTree idCata x = x
+
+        Check.QuickThrowOnFailure property
+        builderCases.Value |> shouldBeGreaterThan 10

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

@@ -0,0 +1,37 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open NUnit.Framework
+open ConsumePlugin
+open FsCheck
+
+[<TestFixture>]
+module TestDirectory =
+    let idCata : FileSystemCata<_> =
+        {
+            FileSystemItem =
+                { new FileSystemItemCataCase<_> with
+                    member _.File file = FileSystemItem.File file
+
+                    member _.Directory name dirSize results =
+                        FileSystemItem.Directory
+                            {
+                                Name = name
+                                DirSize = dirSize
+                                Contents = results
+                            }
+                }
+
+        }
+
+    // Note: this file is preserved as an example of writing an identity cata.
+    // Don't add anything else to this file, because that will muddy the example.
+
+    [<Test>]
+    let ``Cata works`` () =
+        let property (x : FileSystemItem) =
+            FileSystemItemCata.runFileSystemItem idCata x = x
+
+        Check.QuickThrowOnFailure property
+
+// Note: this file is preserved as an example of writing an identity cata.
+// Don't add anything else to this file, because that will muddy the example.

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

@@ -0,0 +1,99 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open NUnit.Framework
+open ConsumePlugin
+open FsCheck
+open FsUnitTyped
+
+[<TestFixture>]
+module TestGift =
+
+    let idCata : GiftCata<_> =
+        {
+            Gift =
+                { new GiftCataCase<_> with
+                    member _.Book b = Gift.Book b
+                    member _.Boxed g = Gift.Boxed g
+                    member _.Chocolate g = Gift.Chocolate g
+                    member _.WithACard g message = Gift.WithACard (g, message)
+                    member _.Wrapped g paper = Gift.Wrapped (g, paper)
+                }
+        }
+
+    let totalCostCata : GiftCata<_> =
+        {
+            Gift =
+                { new GiftCataCase<_> with
+                    member _.Book b = b.price
+                    member _.Boxed g = g + 1.0m
+                    member _.Chocolate c = c.price
+                    member _.WithACard g message = g + 2.0m
+                    member _.Wrapped g paper = g + 0.5m
+                }
+        }
+
+    let descriptionCata : GiftCata<_> =
+        {
+            Gift =
+                { new GiftCataCase<_> with
+                    member _.Book b = b.title
+                    member _.Boxed g = $"%s{g} in a box"
+                    member _.Chocolate c = $"%O{c} chocolate"
+
+                    member _.WithACard g message =
+                        $"%s{g} with a card saying '%s{message}'"
+
+                    member _.Wrapped g paper = $"%s{g} wrapped in %A{paper} paper"
+                }
+        }
+
+    [<Test>]
+    let ``Cata works`` () =
+        let property (x : Gift) = GiftCata.runGift idCata x = x
+
+        Check.QuickThrowOnFailure property
+
+    [<Test>]
+    let ``Example from docs`` () =
+        let wolfHall =
+            {
+                title = "Wolf Hall"
+                price = 20m
+            }
+
+        let yummyChoc =
+            {
+                chocType = SeventyPercent
+                price = 5m
+            }
+
+        let birthdayPresent =
+            WithACard (Wrapped (Book wolfHall, HappyBirthday), "Happy Birthday")
+
+        let christmasPresent = Wrapped (Boxed (Chocolate yummyChoc), HappyHolidays)
+
+        GiftCata.runGift totalCostCata birthdayPresent |> shouldEqual 22.5m
+
+        GiftCata.runGift descriptionCata christmasPresent
+        |> shouldEqual "SeventyPercent chocolate in a box wrapped in HappyHolidays paper"
+
+        let deeplyNestedBox depth =
+            let rec loop depth boxSoFar =
+                match depth with
+                | 0 -> boxSoFar
+                | n -> loop (n - 1) (Boxed boxSoFar)
+
+            loop depth (Book wolfHall)
+
+        deeplyNestedBox 10 |> GiftCata.runGift totalCostCata |> shouldEqual 30.0M
+        deeplyNestedBox 100 |> GiftCata.runGift totalCostCata |> shouldEqual 120.0M
+        deeplyNestedBox 1000 |> GiftCata.runGift totalCostCata |> shouldEqual 1020.0M
+        deeplyNestedBox 10000 |> GiftCata.runGift totalCostCata |> shouldEqual 10020.0M
+
+        deeplyNestedBox 100000
+        |> GiftCata.runGift totalCostCata
+        |> shouldEqual 100020.0M
+
+        deeplyNestedBox 1000000
+        |> GiftCata.runGift totalCostCata
+        |> shouldEqual 1000020.0M

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

@@ -0,0 +1,77 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open NUnit.Framework
+open FsCheck
+open FsUnitTyped
+open ConsumePlugin
+
+[<TestFixture>]
+module TestMyList =
+
+    let idCata<'a> : MyListCata<'a, _> =
+        {
+            MyList =
+                { new MyListCataCase<'a, _> with
+                    member _.Nil = MyList.Nil
+
+                    member _.Cons head tail =
+                        MyList.Cons
+                            {
+                                Head = head
+                                Tail = tail
+                            }
+                }
+        }
+
+    [<Test>]
+    let ``Cata works`` () =
+        let property (x : MyList<int>) = MyListCata.runMyList idCata x = x
+
+        Check.QuickThrowOnFailure property
+
+    let toListCata<'a> =
+        {
+            MyList =
+                { new MyListCataCase<'a, 'a list> with
+                    member _.Nil = []
+                    member _.Cons (head : 'a) (tail : 'a list) = head :: tail
+                }
+        }
+
+    let toListViaCata<'a> (l : MyList<'a>) : 'a list = MyListCata.runMyList toListCata l
+
+
+    [<Test>]
+    let ``Example of a fold converting to a new data structure`` () =
+        let rec toListNaive (l : MyList<int>) : int list =
+            match l with
+            | MyList.Nil -> []
+            | MyList.Cons consCell -> consCell.Head :: toListNaive consCell.Tail
+
+        Check.QuickThrowOnFailure (fun l -> toListNaive l = toListViaCata l)
+
+    [<Test>]
+    let ``Example of equivalence with FoldBack`` () =
+        let baseCase = 0L
+        let atLeaf (head : int) (tail : int64) : int64 = int64 head + tail
+
+        let sumCata =
+            {
+                MyList =
+                    { new MyListCataCase<int, int64> with
+                        member _.Nil = baseCase
+                        member _.Cons (head : int) (tail : int64) = atLeaf head tail
+                    }
+            }
+
+        let viaCata (l : MyList<int>) : int64 = MyListCata.runMyList sumCata l
+
+        let viaFold (l : MyList<int>) : int64 =
+            // choose your favourite "to list" method - here I use the cata
+            // but that could have been done naively
+            (toListViaCata l, baseCase)
+            ||> List.foldBack (fun elt state -> atLeaf elt state)
+
+        let property (l : MyList<int>) = viaCata l = viaFold l
+
+        Check.QuickThrowOnFailure property

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

@@ -0,0 +1,25 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open NUnit.Framework
+open FsCheck
+open FsUnitTyped
+open ConsumePlugin
+
+[<TestFixture>]
+module TestMyList2 =
+
+    let idCata<'a> : MyList2Cata<'a, _> =
+        {
+            MyList2 =
+                { new MyList2CataCase<'a, _> with
+                    member _.Nil = MyList2.Nil
+
+                    member _.Cons (head : 'a) (tail : MyList2<'a>) = MyList2.Cons (head, tail)
+                }
+        }
+
+    [<Test>]
+    let ``Cata works`` () =
+        let property (x : MyList2<int>) = MyList2Cata.runMyList2 idCata x = x
+
+        Check.QuickThrowOnFailure property

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

@@ -21,19 +21,24 @@
     <Compile Include="TestHttpClient\TestVaultClient.fs" />
     <Compile Include="TestHttpClient\TestVariableHeader.fs" />
     <Compile Include="TestMockGenerator\TestMockGenerator.fs" />
+    <Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
+    <Compile Include="TestCataGenerator\TestCataGenerator.fs" />
+    <Compile Include="TestCataGenerator\TestDirectory.fs" />
+    <Compile Include="TestCataGenerator\TestGift.fs" />
+    <Compile Include="TestCataGenerator\TestMyList.fs" />
+    <Compile Include="TestCataGenerator\TestMyList2.fs" />
     <Compile Include="TestRemoveOptions.fs"/>
     <Compile Include="TestSurface.fs"/>
     <None Include="../.github/workflows/dotnet.yaml" />
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Include="ApiSurface" Version="4.0.28"/>
+    <PackageReference Include="ApiSurface" Version="4.0.33"/>
     <PackageReference Include="FsCheck" Version="2.16.6"/>
     <PackageReference Include="FsUnit" Version="6.0.0"/>
-    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.8.0"/>
-    <PackageReference Include="NUnit" Version="4.0.1"/>
+    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.9.0"/>
+    <PackageReference Include="NUnit" Version="4.1.0"/>
     <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
-    <PackageReference Include="coverlet.collector" Version="6.0.0"/>
   </ItemGroup>
 
   <ItemGroup>
@@ -41,8 +46,4 @@
     <ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/>
   </ItemGroup>
 
-  <ItemGroup>
-    <Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
-  </ItemGroup>
-
 </Project>

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -70,6 +70,30 @@ type internal RecordType =
         Accessibility : SynAccess option
     }
 
+/// Anything that is part of an ADT.
+/// A record is a product of stuff; this type represents one of those stuffs.
+type internal AdtNode =
+    {
+        Type : SynType
+        Name : Ident option
+        /// An ordered list, so you can look up any given generic within `this.Type`
+        /// to discover what its index is in the parent DU which defined it.
+        GenericsOfParent : SynTyparDecl list
+    }
+
+/// A DU is a sum of products (e.g. `type Thing = Foo of a * b`);
+/// similarly a record is a product.
+/// This type represents a product in that sense.
+type internal AdtProduct =
+    {
+        Name : SynIdent
+        Fields : AdtNode list
+        /// This AdtProduct represents a product in which there might be
+        /// some bound type parameters. This field lists the bound
+        /// type parameters in the order they appeared on the parent type.
+        Generics : SynTyparDecl list
+    }
+
 [<RequireQualifiedAccess>]
 module internal AstHelper =
 
@@ -383,6 +407,76 @@ module internal AstHelper =
             Accessibility = accessibility
         }
 
+    let getUnionCases
+        (SynTypeDefn.SynTypeDefn (info, repr, _, _, _, _))
+        : AdtProduct list * SynTyparDecl list * SynAccess option
+        =
+        let typars, access =
+            match info with
+            | SynComponentInfo (_, typars, _, _, _, _, access, _) -> typars, access
+
+        let typars =
+            match typars with
+            | None -> []
+            | Some (SynTyparDecls.PrefixList (decls, _)) -> decls
+            | Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ]
+            | Some (SynTyparDecls.PostfixList (decls, constraints, _)) ->
+                if not constraints.IsEmpty then
+                    failwith "Constrained type parameters not currently supported"
+
+                decls
+
+        match repr with
+        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_, cases, _), _) ->
+            let cases =
+                cases
+                |> List.map (fun (SynUnionCase.SynUnionCase (_, ident, kind, _, _, _, _)) ->
+                    match kind with
+                    | SynUnionCaseKind.FullType _ -> failwith "FullType union cases not supported"
+                    | SynUnionCaseKind.Fields fields ->
+                        {
+                            Name = ident
+                            Fields =
+                                fields
+                                |> List.map (fun (SynField.SynField (_, _, id, ty, _, _, _, _, _)) ->
+                                    {
+                                        Type = ty
+                                        Name = id
+                                        GenericsOfParent = typars
+                                    }
+                                )
+                            Generics = typars
+                        }
+                )
+
+            cases, typars, access
+        | _ -> failwithf "Failed to get union cases for type that was: %+A" repr
+
+    let getRecordFields (SynTypeDefn.SynTypeDefn (typeInfo, repr, _, _, _, _)) : AdtNode list =
+        let (SynComponentInfo.SynComponentInfo (typeParams = typars)) = typeInfo
+
+        let typars =
+            match typars with
+            | None -> []
+            | Some (SynTyparDecls.PrefixList (decls, _)) -> decls
+            | Some (SynTyparDecls.SinglePrefix (l, _)) -> [ l ]
+            | Some (SynTyparDecls.PostfixList (decls, constraints, _)) ->
+                if not constraints.IsEmpty then
+                    failwith "Constrained type parameters not currently supported"
+
+                decls
+
+        match repr with
+        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_, fields, _), _) ->
+            fields
+            |> List.map (fun (SynField.SynField (_, _, ident, ty, _, _, _, _, _)) ->
+                {
+                    Name = ident
+                    Type = ty
+                    GenericsOfParent = typars
+                }
+            )
+        | _ -> failwithf "Failed to get record elements for type that was: %+A" repr
 
 [<AutoOpen>]
 module internal SynTypePatterns =

WoofWare.Myriad.Plugins/HttpClientGenerator.fs

@@ -756,12 +756,6 @@ module internal HttpClientGenerator =
             | _ -> None
         )
 
-    let lowerFirstLetter (x : Ident) : Ident =
-        let result = StringBuilder x.idText.Length
-        result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
-        result.Append x.idText.[1..] |> ignore
-        Ident.Create ((result : StringBuilder).ToString ())
-
     let createModule
         (opens : SynOpenDeclTarget list)
         (ns : LongIdent)
@@ -891,7 +885,7 @@ module internal HttpClientGenerator =
                         Some (SynBindingReturnInfo.Create pi.Type),
                         SynExpr.CreateApp (
                             SynExpr.CreateLongIdent (
-                                SynLongIdent.CreateFromLongIdent [ lowerFirstLetter pi.Identifier ]
+                                SynLongIdent.CreateFromLongIdent [ Ident.lowerFirstLetter pi.Identifier ]
                             ),
                             SynExpr.CreateConst SynConst.Unit
                         ),
@@ -927,7 +921,7 @@ module internal HttpClientGenerator =
             properties
             |> List.map (fun (_, pi) ->
                 SynPat.CreateTyped (
-                    SynPat.CreateNamed (lowerFirstLetter pi.Identifier),
+                    SynPat.CreateNamed (Ident.lowerFirstLetter pi.Identifier),
                     SynType.CreateFun (SynType.CreateLongIdent "unit", pi.Type)
                 )
                 |> SynPat.CreateParen

WoofWare.Myriad.Plugins/Ident.fs

@@ -0,0 +1,14 @@
+namespace WoofWare.Myriad.Plugins
+
+open System
+open System.Text
+open Fantomas.FCS.Syntax
+open Myriad.Core
+
+[<RequireQualifiedAccess>]
+module internal Ident =
+    let lowerFirstLetter (x : Ident) : Ident =
+        let result = StringBuilder x.idText.Length
+        result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
+        result.Append x.idText.[1..] |> ignore
+        Ident.Create ((result : StringBuilder).ToString ())

WoofWare.Myriad.Plugins/SurfaceBaseline.txt

@@ -1,3 +1,5 @@
+WoofWare.Myriad.Plugins.CreateCatamorphismGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
+WoofWare.Myriad.Plugins.CreateCatamorphismGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.HttpClientGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
 WoofWare.Myriad.Plugins.HttpClientGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.InterfaceMockGenerator inherit obj, implements Myriad.Core.IMyriadGenerator

WoofWare.Myriad.Plugins/SynExpr.fs

@@ -275,3 +275,39 @@ module internal SynExpr =
                 else
                     SynLeadingKeyword.Let range0
         }
+
+    /// {ident} - {rhs}
+    let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
+        SynExpr.CreateApp (
+            SynExpr.CreateAppInfix (
+                SynExpr.CreateLongIdent (
+                    SynLongIdent.SynLongIdent (
+                        [ Ident.Create "op_Subtraction" ],
+                        [],
+                        [ Some (IdentTrivia.OriginalNotation "-") ]
+                    )
+                ),
+                SynExpr.CreateLongIdent ident
+            ),
+            rhs
+        )
+
+    /// {ident} - {n}
+    let minusN (ident : SynLongIdent) (n : int) : SynExpr =
+        minus ident (SynExpr.CreateConst (SynConst.Int32 n))
+
+    /// {y} > {x}
+    let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
+        SynExpr.CreateApp (
+            SynExpr.CreateAppInfix (
+                SynExpr.CreateLongIdent (
+                    SynLongIdent.SynLongIdent (
+                        [ Ident.Create "op_GreaterThan" ],
+                        [],
+                        [ Some (IdentTrivia.OriginalNotation ">") ]
+                    )
+                ),
+                y
+            ),
+            x
+        )

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

@@ -25,6 +25,7 @@
 
   <ItemGroup>
     <Compile Include="List.fs"/>
+    <Compile Include="Ident.fs" />
     <Compile Include="AstHelper.fs"/>
     <Compile Include="SynExpr.fs"/>
     <Compile Include="SynType.fs"/>
@@ -34,6 +35,7 @@
     <Compile Include="JsonSerializeGenerator.fs"/>
     <Compile Include="JsonParseGenerator.fs"/>
     <Compile Include="HttpClientGenerator.fs"/>
+    <Compile Include="CataGenerator.fs" />
     <EmbeddedResource Include="version.json"/>
     <EmbeddedResource Include="SurfaceBaseline.txt"/>
     <None Include="..\README.md">

WoofWare.Myriad.Plugins/version.json

@@ -1,7 +1,7 @@
 {
-  "version": "2.0",
+  "version": "2.1",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],
   "pathFilters": null
-}
+}

analyzers/analyzers.fsproj

@@ -10,7 +10,7 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.8.0]" />
+    <PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.9.3]" />
   </ItemGroup>
 
 </Project>

nix/deps.nix

@@ -3,23 +3,18 @@
 {fetchNuGet}: [
   (fetchNuGet {
     pname = "fsharp-analyzers";
-    version = "0.24.0";
-    sha256 = "sha256-cNaM/yHI28sHDGamKMrU237ltOyrR+8vPNUImB5RxjU=";
+    version = "0.25.0";
+    sha256 = "sha256-njfJYi40jNvrD+mgu9LtQw2Omh8P1SSDThesozH0KQY=";
   })
   (fetchNuGet {
     pname = "fantomas";
-    version = "6.3.0-alpha-007";
-    sha256 = "sha256-uZw6h6k/DS4BcYtK9cv8TLS0H8MZDO3WBaPPTdtTgu0=";
+    version = "6.3.3";
+    sha256 = "sha256-02uTwRPJkRZtjJ7fOJdHSvc17DszkXjT5X9jGuRZlA4=";
   })
   (fetchNuGet {
     pname = "ApiSurface";
-    version = "4.0.28";
-    sha256 = "1gg0dqbgbb8aqn2lxi5gf2wq969kgskby5wph6m2b3hdkz7265ak";
-  })
-  (fetchNuGet {
-    pname = "coverlet.collector";
-    version = "6.0.0";
-    sha256 = "12j34vrkmph8lspbafnqmfnj2qvysz1jcrks2khw798s6dwv0j90";
+    version = "4.0.33";
+    sha256 = "0mmsa5gxfd3bbgacip0c1hljwd958zcx1012qdh033sx6nfz3v36";
   })
   (fetchNuGet {
     pname = "Fantomas.Core";
@@ -121,21 +116,11 @@
     version = "8.0.0";
     sha256 = "0055f69q3hbagqp8gl3nk0vfn4qyqyxsxyy7pd0g7wm3z28byzmx";
   })
-  (fetchNuGet {
-    pname = "Microsoft.CodeCoverage";
-    version = "17.8.0";
-    sha256 = "173wjadp3gan4x2jfjchngnc4ca4mb95h1sbb28jydfkfw0z1zvj";
-  })
   (fetchNuGet {
     pname = "Microsoft.CodeCoverage";
     version = "17.9.0";
     sha256 = "1gljgi69k0fz8vy8bn6xlyxabj6q4vls2zza9wz7ng6ix3irm89r";
   })
-  (fetchNuGet {
-    pname = "Microsoft.NET.Test.Sdk";
-    version = "17.8.0";
-    sha256 = "1syvl3g0hbrcgfi9rq6pld8s8hqqww4dflf1lxn59ccddyyx0gmv";
-  })
   (fetchNuGet {
     pname = "Microsoft.NET.Test.Sdk";
     version = "17.9.0";
@@ -281,21 +266,11 @@
     version = "8.0.0";
     sha256 = "1gdx7n45wwia3yvang3ls92sk3wrymqcx9p349j8wba2lyjf9m44";
   })
-  (fetchNuGet {
-    pname = "Microsoft.TestPlatform.ObjectModel";
-    version = "17.8.0";
-    sha256 = "0b0i7lmkrcfvim8i3l93gwqvkhhhfzd53fqfnygdqvkg6np0cg7m";
-  })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.ObjectModel";
     version = "17.9.0";
     sha256 = "1kgsl9w9fganbm9wvlkqgk0ag9hfi58z88rkfybc6kvg78bx89ca";
   })
-  (fetchNuGet {
-    pname = "Microsoft.TestPlatform.TestHost";
-    version = "17.8.0";
-    sha256 = "0f5jah93kjkvxwmhwb78lw11m9pkkq9fvf135hpymmmpxqbdh97q";
-  })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.TestHost";
     version = "17.9.0";
@@ -316,11 +291,6 @@
     version = "3.6.133";
     sha256 = "1cdw8krvsnx0n34f7fm5hiiy7bs6h3asvncqcikc0g46l50w2j80";
   })
-  (fetchNuGet {
-    pname = "NETStandard.Library";
-    version = "2.0.0";
-    sha256 = "1bc4ba8ahgk15m8k4nd7x406nhi0kwqzbgjk2dmw52ss553xz7iy";
-  })
   (fetchNuGet {
     pname = "NETStandard.Library";
     version = "2.0.3";
@@ -338,28 +308,23 @@
   })
   (fetchNuGet {
     pname = "NuGet.Common";
-    version = "6.8.0";
-    sha256 = "0l3ij8iwy7wj6s7f93lzi9168r4wz8zyin6a08iwgk7hvq44cia1";
+    version = "6.9.1";
+    sha256 = "0ic3d46r9v05pkczpmskw86yzixm6iwshbw0ya8i2957nhhlymw8";
   })
   (fetchNuGet {
     pname = "NuGet.Configuration";
-    version = "6.8.0";
-    sha256 = "0x03p408smkmv1gv7pmvsia4lkn0xaj4wfrkl58pjf8bbv51y0yw";
+    version = "6.9.1";
+    sha256 = "07z4qgbibpg59j2r05ifnqdyqf2xinm33rx7gjyr1f73kzg01m33";
   })
   (fetchNuGet {
     pname = "NuGet.Frameworks";
-    version = "6.5.0";
-    sha256 = "0s37d1p4md0k6d4cy6sq36f2dgkd9qfbzapxhkvi8awwh0vrynhj";
-  })
-  (fetchNuGet {
-    pname = "NuGet.Frameworks";
-    version = "6.8.0";
-    sha256 = "0i2xvhgkjkjr496i3pg8hamwv6505fia45qhn7jg5m01wb3cvsjl";
+    version = "6.9.1";
+    sha256 = "0s3az3ac53icjnmb14hfjcmkvzscvrkm62jgqf48yvsbysyhqm5s";
   })
   (fetchNuGet {
     pname = "NuGet.Packaging";
-    version = "6.8.0";
-    sha256 = "031z4s905bxi94h3f0qy4j1b6jxdxgqgpkzqvvpfxch07szxcbim";
+    version = "6.9.1";
+    sha256 = "0w0arkmzg3qh1brq4vm10zrsjm7nw706ld4y5kqcmvjpd16f4b4y";
   })
   (fetchNuGet {
     pname = "NuGet.Protocol";
@@ -368,18 +333,13 @@
   })
   (fetchNuGet {
     pname = "NuGet.Versioning";
-    version = "6.8.0";
-    sha256 = "1sd25h46fd12ng780r02q4ijcx1imkb53kj1y2y7cwg5myh537ks";
+    version = "6.9.1";
+    sha256 = "0xrs82dydy9cgxf0qypr01wawwnq1nf6fc7rwisb4y5v4r259fdm";
   })
   (fetchNuGet {
     pname = "NUnit";
-    version = "3.13.3";
-    sha256 = "0wdzfkygqnr73s6lpxg5b1pwaqz9f414fxpvpdmf72bvh4jaqzv6";
-  })
-  (fetchNuGet {
-    pname = "NUnit";
-    version = "4.0.1";
-    sha256 = "0jgiq3dbwli5r70j0bw7021d69r7bhr58s8kphlpjmf7k47l5pcd";
+    version = "4.1.0";
+    sha256 = "0fj6xwgqaxq3mrai86bklclfmjkzf038mrslwfqf4ignaz9f7g5j";
   })
   (fetchNuGet {
     pname = "NUnit3TestAdapter";