Add catamorphism generator (#97)

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 : TreeCata<_, _> =
+        {
+            Tree =
+                { new TreeCataCase<_, _> with
+                    member _.Const x = Const x
+                    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.Int 0), Tree.Const (Const.String ""), PairOpKind.ThenDoSeq)
+
+        TreeCata.runTree idCata x |> shouldEqual x
+
+
+    [<Test>]
+    let ``Cata works`` () =
+        let builderCases = ref 0
+
+        let property (x : Tree) =
+            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/WoofWare.Myriad.Plugins.Test.fsproj

@@ -21,6 +21,10 @@
     <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="TestRemoveOptions.fs"/>
     <Compile Include="TestSurface.fs"/>
     <None Include="../.github/workflows/dotnet.yaml" />
@@ -41,8 +45,4 @@
     <ProjectReference Include="..\ConsumePlugin\ConsumePlugin.fsproj"/>
   </ItemGroup>
 
-  <ItemGroup>
-    <Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
-  </ItemGroup>
-
 </Project>