Use more of the Whippet Fantomas client lib (#284)

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -4,6 +4,7 @@ open System
 open System.Text
 open Fantomas.FCS.Syntax
 open Fantomas.FCS.Text.Range
+open TypeEquality
 open WoofWare.Whippet.Fantomas
 
 type internal ArgParserOutputSpec =
@@ -1757,10 +1758,7 @@ type ArgParserGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let types =
-                Ast.extractTypeDefn ast
-                |> List.groupBy (fst >> List.map _.idText >> String.concat ".")
-                |> List.map (fun (_, v) -> fst (List.head v), List.collect snd v)
+            let types = Ast.getTypes ast
 
             let opens = AstHelper.extractOpens ast
 

WoofWare.Myriad.Plugins/CataGenerator.fs

@@ -1174,6 +1174,29 @@ module internal CataGenerator =
         ]
         |> SynModuleOrNamespace.createNamespace ns
 
+    /// This function comes from Myriad, and is therefore derived from an Apache 2.0-licenced work.
+    /// https://github.com/MoiraeSoftware/myriad/blob/3c9818faabf9d508c10c28d5ecd26e66fafb48a1/src/Myriad.Core/Ast.fs#L160
+    /// A copy of the Apache 2.0 licence is at ApacheLicence.txt.
+    let groupedTypeDefns (ast : ParsedInput) : (LongIdent * SynTypeDefn list) list =
+        let rec extractTypes (moduleDecls : SynModuleDecl list) (ns : LongIdent) =
+            [
+                for moduleDecl in moduleDecls do
+                    match moduleDecl with
+                    | SynModuleDecl.Types (types, _) -> yield (ns, types)
+                    | SynModuleDecl.NestedModule (SynComponentInfo (_, _, _, longId, _, _, _, _), _, decls, _, _, _) ->
+                        let combined = longId |> List.append ns
+                        yield! (extractTypes decls combined)
+                    | _ -> ()
+            ]
+
+        [
+            match ast with
+            | ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
+                for SynModuleOrNamespace (namespaceId, _, _, moduleDecls, _, _, _, _, _) in modules do
+                    yield! extractTypes moduleDecls namespaceId
+            | _ -> ()
+        ]
+
 open Myriad.Core
 
 /// Myriad generator that provides a catamorphism for an algebraic data type.
@@ -1187,7 +1210,7 @@ type CreateCatamorphismGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let types = Ast.extractTypeDefn ast
+            let types = CataGenerator.groupedTypeDefns ast
 
             let opens = AstHelper.extractOpens ast
 

WoofWare.Myriad.Plugins/HttpClientGenerator.fs

@@ -996,7 +996,7 @@ type HttpClientGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let types = Ast.extractTypeDefn ast
+            let types = Ast.getTypes ast
 
             let opens = AstHelper.extractOpens ast
 

WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs

@@ -291,14 +291,14 @@ type InterfaceMockGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let types = Ast.extractTypeDefn ast
+            let types = Ast.getTypes ast
 
             let namespaceAndInterfaces =
                 types
                 |> List.choose (fun (ns, types) ->
                     types
                     |> List.choose (fun typeDef ->
-                        match Ast.getAttribute<GenerateMockAttribute> typeDef with
+                        match SynTypeDefn.getAttribute typeof<GenerateMockAttribute>.Name typeDef with
                         | None ->
                             let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
 

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -711,13 +711,13 @@ type JsonParseGenerator () =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
             let relevantTypes =
-                Ast.extractTypeDefn ast
+                Ast.getTypes ast
                 |> List.map (fun (name, defns) ->
                     defns
                     |> List.choose (fun defn ->
-                        if Ast.isRecord defn then Some defn
-                        elif Ast.isDu defn then Some defn
-                        elif AstHelper.isEnum defn then Some defn
+                        if SynTypeDefn.isRecord defn then Some defn
+                        elif SynTypeDefn.isDu defn then Some defn
+                        elif SynTypeDefn.isEnum defn then Some defn
                         else None
                     )
                     |> fun defns -> name, defns

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -528,13 +528,13 @@ type JsonSerializeGenerator () =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
             let relevantTypes =
-                Ast.extractTypeDefn ast
+                Ast.getTypes ast
                 |> List.map (fun (name, defns) ->
                     defns
                     |> List.choose (fun defn ->
-                        if Ast.isRecord defn then Some defn
-                        elif Ast.isDu defn then Some defn
-                        elif AstHelper.isEnum defn then Some defn
+                        if SynTypeDefn.isRecord defn then Some defn
+                        elif SynTypeDefn.isDu defn then Some defn
+                        elif SynTypeDefn.isEnum defn then Some defn
                         else None
                     )
                     |> fun defns -> name, defns

WoofWare.Myriad.Plugins/MyriadParamParser.fs

@@ -2,28 +2,6 @@ namespace WoofWare.Myriad.Plugins
 
 open System.Collections.Generic
 
-type internal DesiredGenerator =
-    | InterfaceMock of isInternal : bool option
-    | JsonParse of extensionMethod : bool option
-    | JsonSerialize of extensionMethod : bool option
-    | HttpClient of extensionMethod : bool option
-
-    static member Parse (s : string) =
-        match s with
-        | "GenerateMock" -> DesiredGenerator.InterfaceMock None
-        | "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true)
-        | "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false)
-        | "JsonParse" -> DesiredGenerator.JsonParse None
-        | "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true)
-        | "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false)
-        | "JsonSerialize" -> DesiredGenerator.JsonSerialize None
-        | "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true)
-        | "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false)
-        | "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}"
-
 [<RequireQualifiedAccess>]
 module internal MyriadParamParser =
     (*

WoofWare.Myriad.Plugins/Parameters.fs

@@ -0,0 +1,23 @@
+namespace WoofWare.Myriad.Plugins
+
+type internal DesiredGenerator =
+    | InterfaceMock of isInternal : bool option
+    | JsonParse of extensionMethod : bool option
+    | JsonSerialize of extensionMethod : bool option
+    | HttpClient of extensionMethod : bool option
+
+    static member Parse (s : string) =
+        match s with
+        | "GenerateMock" -> DesiredGenerator.InterfaceMock None
+        | "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true)
+        | "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false)
+        | "JsonParse" -> DesiredGenerator.JsonParse None
+        | "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true)
+        | "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false)
+        | "JsonSerialize" -> DesiredGenerator.JsonSerialize None
+        | "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true)
+        | "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false)
+        | "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}"

WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs

@@ -1,5 +1,6 @@
 namespace WoofWare.Myriad.Plugins
 
+open System
 open Fantomas.FCS.Syntax
 open Fantomas.FCS.Xml
 open WoofWare.Whippet.Fantomas
@@ -59,7 +60,7 @@ module internal RemoveOptionsGenerator =
                 Attributes = []
             }
 
-        let typeDecl = AstHelper.defineRecordType record
+        let typeDecl = RecordType.ToAst record
 
         SynModuleDecl.Types ([ typeDecl ], range0)
 
@@ -146,44 +147,31 @@ type RemoveOptionsGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let records = Ast.extractRecords ast
+            let records = Ast.getRecords ast
 
             let namespaceAndRecords =
                 records
-                |> List.choose (fun (ns, types) ->
-                    match
-                        types
-                        |> List.filter (SynTypeDefn.hasAttribute typeof<RemoveOptionsAttribute>.Name)
-                    with
-                    | [] -> None
-                    | types ->
-                        let types =
-                            types
-                            |> List.map (fun ty ->
-                                match ty with
-                                | SynTypeDefn.SynTypeDefn (sci,
-                                                           SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access,
-                                                                                                                 fields,
-                                                                                                                 _),
-                                                                                   _),
-                                                           smd,
-                                                           smdo,
-                                                           _,
-                                                           _) -> RecordType.OfRecord sci smd access fields
-                                | _ -> failwith "unexpectedly not a record"
-                            )
-
-                        Some (ns, types)
+                |> List.collect (fun (ns, ty) ->
+                    ty
+                    |> List.filter (fun record ->
+                        record.Attributes
+                        |> List.exists (fun attr ->
+                            attr.TypeName.LongIdent
+                            |> List.last
+                            |> _.idText
+                            |> fun s ->
+                                if s.EndsWith ("Attribute", StringComparison.Ordinal) then
+                                    s
+                                else
+                                    $"%s{s}Attribute"
+                            |> (=) typeof<RemoveOptionsAttribute>.Name
+                        )
+                    )
+                    |> List.map (fun ty -> ns, ty)
                 )
 
             let modules =
                 namespaceAndRecords
-                |> List.collect (fun (ns, records) ->
-                    records
-                    |> List.map (fun record ->
-                        let recordModule = RemoveOptionsGenerator.createRecordModule ns record
-                        recordModule
-                    )
-                )
+                |> List.map (fun (ns, record) -> RemoveOptionsGenerator.createRecordModule ns record)
 
             Output.Ast modules

WoofWare.Myriad.Plugins/Teq.fs

@@ -1,18 +0,0 @@
-namespace WoofWare.Myriad.Plugins
-
-// Extracted from https://github.com/G-Research/TypeEquality
-// which is Apache-2.0 licenced. See `TeqLicence.txt`.
-// We inline this code because Myriad doesn't seem to reliably load package references in the generator.
-// I have reformatted a little, and stripped out all the code I don't use.
-
-type internal Teq<'a, 'b> = private | Teq of ('a -> 'b) * ('b -> 'a)
-
-[<RequireQualifiedAccess>]
-module internal Teq =
-
-    let refl<'a> : Teq<'a, 'a> = Teq (id, id)
-    let cast (Teq (f, _)) a = f a
-
-    [<RequireQualifiedAccess>]
-    module Cong =
-        let believeMe<'a, 'b, 'a2, 'b2> (_ : Teq<'a, 'b>) : Teq<'a2, 'b2> = unbox <| (refl : Teq<'a2, 'a2>)

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

@@ -20,6 +20,7 @@
 
   <ItemGroup>
     <PackageReference Include="Myriad.Core" Version="0.8.3" />
+    <PackageReference Include="TypeEquality" Version="0.3.0" />
     <PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.2.1" />
     <!-- the lowest version allowed by Myriad.Core -->
     <PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
@@ -28,9 +29,9 @@
   <ItemGroup>
     <Compile Include="List.fs"/>
     <Compile Include="Text.fs" />
-    <Compile Include="Teq.fs" />
     <Compile Include="Measure.fs" />
     <Compile Include="AstHelper.fs" />
+    <Compile Include="Parameters.fs" />
     <Compile Include="RemoveOptionsGenerator.fs"/>
     <Compile Include="MyriadParamParser.fs" />
     <Compile Include="InterfaceMockGenerator.fs"/>
@@ -41,7 +42,7 @@
     <Compile Include="ArgParserGenerator.fs" />
     <Compile Include="Swagger.fs" />
     <Compile Include="SwaggerClientGenerator.fs" />
-    <None Include="TeqLicence.txt" />
+    <None Include="ApacheLicence.txt" />
     <EmbeddedResource Include="version.json"/>
     <EmbeddedResource Include="SurfaceBaseline.txt"/>
     <None Include="..\README.md">

nix/deps.nix

@@ -326,6 +326,11 @@
     version = "7.0.3";
     hash = "sha256-aSJZ17MjqaZNQkprfxm/09LaCoFtpdWmqU9BTROzWX4=";
   })
+  (fetchNuGet {
+    pname = "TypeEquality";
+    version = "0.3.0";
+    hash = "sha256-V50xAOzzyUJrY+MYPRxtnqW5MVeATXCes89wPprv1r4=";
+  })
   (fetchNuGet {
     pname = "WoofWare.Whippet.Fantomas";
     version = "0.2.1";