Add catamorphism generator (#97)

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -70,6 +70,23 @@ 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
+    }
+
+/// 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
+    }
+
 [<RequireQualifiedAccess>]
 module internal AstHelper =
 
@@ -383,6 +400,39 @@ module internal AstHelper =
             Accessibility = accessibility
         }
 
+    let getUnionCases (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _)) : AdtProduct list =
+        match repr with
+        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_, 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
+                                }
+                            )
+                    }
+            )
+        | _ -> failwithf "Failed to get union cases for type that was: %+A" repr
+
+    let getRecordFields (SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _)) : AdtNode list =
+        match repr with
+        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_, fields, _), _) ->
+            fields
+            |> List.map (fun (SynField.SynField (_, _, ident, ty, _, _, _, _, _)) ->
+                {
+                    Name = ident
+                    Type = ty
+                }
+            )
+        | _ -> 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
-}
+}