Add JSON serialisation of DUs (#144)

ConsumePlugin/GeneratedCatamorphism.fs

@@ -60,7 +60,7 @@ module TreeCata =
             instructions.RemoveAt (instructions.Count - 1)
 
             match currentInstruction with
-            | Instruction.Process__TreeBuilder x ->
+            | Instruction.Process__TreeBuilder (x) ->
                 match x with
                 | TreeBuilder.Child (arg0_0) ->
                     instructions.Add Instruction.TreeBuilder_Child
@@ -68,7 +68,7 @@ module TreeCata =
                 | TreeBuilder.Parent (arg0_0) ->
                     instructions.Add Instruction.TreeBuilder_Parent
                     instructions.Add (Instruction.Process__Tree arg0_0)
-            | Instruction.Process__Tree x ->
+            | 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) ->

ConsumePlugin/GeneratedFileSystem.fs

@@ -41,7 +41,7 @@ module FileSystemItemCata =
             instructions.RemoveAt (instructions.Count - 1)
 
             match currentInstruction with
-            | Instruction.Process__FileSystemItem x ->
+            | Instruction.Process__FileSystemItem (x) ->
                 match x with
                 | FileSystemItem.Directory ({
                                                 Name = name
@@ -116,7 +116,7 @@ module GiftCata =
             instructions.RemoveAt (instructions.Count - 1)
 
             match currentInstruction with
-            | Instruction.Process__Gift x ->
+            | 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

ConsumePlugin/GeneratedSerde.fs

@@ -149,6 +149,37 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
                 )
 
             node :> _
+namespace ConsumePlugin
+
+open System
+open System.Collections.Generic
+open System.Text.Json.Serialization
+
+/// Module containing JSON serializing extension members for the FirstDu type
+[<AutoOpen>]
+module FirstDuJsonSerializeExtension =
+    /// Extension methods for JSON parsing
+    type FirstDu with
+
+        /// Serialize to a JSON node
+        static member toJsonNode (input : FirstDu) : System.Text.Json.Nodes.JsonNode =
+            let node = System.Text.Json.Nodes.JsonObject ()
+
+            match input with
+            | FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase")
+            | FirstDu.Case1 (arg0) ->
+                node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1")
+                let dataNode = System.Text.Json.Nodes.JsonObject ()
+                dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0)
+                node.Add ("data", dataNode)
+            | FirstDu.Case2 (arg0, arg1) ->
+                node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case2")
+                let dataNode = System.Text.Json.Nodes.JsonObject ()
+                dataNode.Add ("record", JsonRecordTypeWithBoth.toJsonNode arg0)
+                dataNode.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int> arg1)
+                node.Add ("data", dataNode)
+
+            node :> _
 
 namespace ConsumePlugin
 

ConsumePlugin/ListCata.fs

@@ -41,7 +41,7 @@ module MyListCata =
             instructions.RemoveAt (instructions.Count - 1)
 
             match currentInstruction with
-            | Instruction.Process__MyList x ->
+            | Instruction.Process__MyList (x) ->
                 match x with
                 | MyList.Nil -> cata.MyList.Nil |> myListStack.Add
                 | MyList.Cons ({
@@ -97,7 +97,7 @@ module MyList2Cata =
             instructions.RemoveAt (instructions.Count - 1)
 
             match currentInstruction with
-            | Instruction.Process__MyList2 x ->
+            | Instruction.Process__MyList2 (x) ->
                 match x with
                 | MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
                 | MyList2.Cons (arg0_0, arg1_0) ->

ConsumePlugin/SerializationAndDeserialization.fs

@@ -27,3 +27,9 @@ type JsonRecordTypeWithBoth =
         E : string array
         F : int[]
     }
+
+[<WoofWare.Myriad.Plugins.JsonSerialize true>]
+type FirstDu =
+    | EmptyCase
+    | Case1 of data : string
+    | Case2 of record : JsonRecordTypeWithBoth * i : int

README.md

@@ -143,6 +143,9 @@ module InnerTypeWithBoth =
         node
 ```
 
+Also includes an *opinionated* serializer for discriminated unions.
+(Any such serializer must be opinionated, because JSON does not natively model DUs.)
+
 As in `JsonParse`, you can optionally supply the boolean `true` to the attribute,
 which will cause Myriad to stamp out an extension method rather than a module with the same name as the type.
 

WoofWare.Myriad.Plugins/CataGenerator.fs

@@ -1113,7 +1113,7 @@ module internal CataGenerator =
                 analysis.AssociatedProcessInstruction,
                 None,
                 None,
-                SynArgPats.Pats [ SynPat.CreateNamed (Ident.Create "x") ],
+                SynArgPats.create [ Ident.Create "x" ],
                 None,
                 range0
             ),
@@ -1162,22 +1162,16 @@ module internal CataGenerator =
                     |> Seq.mapi (fun i x -> (i, x))
                     |> Seq.choose (fun (i, case) ->
                         match case.Description with
-                        | FieldDescription.NonRecursive _ -> SynPat.CreateNamed case.ArgName |> Some
-                        | FieldDescription.ListSelf _ -> SynPat.CreateNamed case.ArgName |> Some
+                        | FieldDescription.NonRecursive _ -> case.ArgName |> Some
+                        | FieldDescription.ListSelf _ -> case.ArgName |> Some
                         | FieldDescription.Self _ -> None
                     )
                     |> Seq.toList
 
-                let lhs =
-                    match lhsNames with
-                    | [] -> []
-                    | lhsNames ->
-                        SynPat.Tuple (false, lhsNames, List.replicate (lhsNames.Length - 1) range0, range0)
-                        |> SynPat.CreateParen
-                        |> List.singleton
+                let lhs = SynArgPats.create lhsNames
 
                 let pat =
-                    SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, SynArgPats.Pats lhs, None, range0)
+                    SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, lhs, None, range0)
 
                 let populateArgs =
                     unionCase.FlattenedFields

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -566,61 +566,61 @@ module internal JsonParseGenerator =
 
             SynModuleDecl.CreateLet [ binding ]
 
-    let createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
+    let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
         let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
             typeDefn
 
-        let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
+        let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
             synComponentInfo
 
-        match synTypeDefnRepr with
-        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
+        let attributes =
+            if spec.ExtensionMethods then
+                [ SynAttributeList.Create SynAttribute.autoOpen ]
+            else
+                [
+                    SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
+                    SynAttributeList.Create SynAttribute.compilationRepresentation
+                ]
 
-            let decls = [ createMaker spec recordId recordFields ]
+        let xmlDoc =
+            let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
 
-            let attributes =
+            let description =
                 if spec.ExtensionMethods then
-                    [ SynAttributeList.Create SynAttribute.autoOpen ]
+                    "extension members"
                 else
-                    [
-                        SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
-                        SynAttributeList.Create SynAttribute.compilationRepresentation
-                    ]
+                    "methods"
 
-            let xmlDoc =
-                let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
+            $" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
+            |> PreXmlDoc.Create
 
-                let description =
-                    if spec.ExtensionMethods then
-                        "extension members"
-                    else
-                        "methods"
+        let moduleName =
+            if spec.ExtensionMethods then
+                match ident with
+                | [] -> failwith "unexpectedly got an empty identifier for record name"
+                | ident ->
+                    let expanded =
+                        List.last ident
+                        |> fun i -> i.idText
+                        |> fun s -> s + "JsonParseExtension"
+                        |> Ident.Create
 
-                $" Module containing JSON parsing %s{description} for the %s{fullyQualified} type"
-                |> PreXmlDoc.Create
+                    List.take (List.length ident - 1) ident @ [ expanded ]
+            else
+                ident
 
-            let moduleName =
-                if spec.ExtensionMethods then
-                    match recordId with
-                    | [] -> failwith "unexpectedly got an empty identifier for record name"
-                    | recordId ->
-                        let expanded =
-                            List.last recordId
-                            |> fun i -> i.idText
-                            |> fun s -> s + "JsonParseExtension"
-                            |> Ident.Create
+        let info =
+            SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
 
-                        List.take (List.length recordId - 1) recordId @ [ expanded ]
-                else
-                    recordId
+        let decls =
+            match synTypeDefnRepr with
+            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
+                [ createMaker spec ident recordFields ]
+            | _ -> failwithf "Not a record type"
 
-            let info =
-                SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
+        let mdl = SynModuleDecl.CreateNestedModule (info, decls)
 
-            let mdl = SynModuleDecl.CreateNestedModule (info, decls)
-
-            SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
-        | _ -> failwithf "Not a record type"
+        SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
 
 /// Myriad generator that provides a method (possibly an extension method) for a record type,
 /// containing a JSON parse function.
@@ -634,10 +634,20 @@ type JsonParseGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let records = Ast.extractRecords ast
+            let recordsAndUnions =
+                Ast.extractTypeDefn 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
+                        else None
+                    )
+                    |> fun defns -> name, defns
+                )
 
-            let namespaceAndRecords =
-                records
+            let namespaceAndTypes =
+                recordsAndUnions
                 |> List.choose (fun (ns, types) ->
                     types
                     |> List.choose (fun typeDef ->
@@ -665,13 +675,9 @@ type JsonParseGenerator () =
                 )
 
             let modules =
-                namespaceAndRecords
-                |> List.collect (fun (ns, records) ->
-                    records
-                    |> List.map (fun (record, spec) ->
-                        let recordModule = JsonParseGenerator.createRecordModule ns spec record
-                        recordModule
-                    )
+                namespaceAndTypes
+                |> List.collect (fun (ns, types) ->
+                    types |> List.map (fun (ty, spec) -> JsonParseGenerator.createModule ns spec ty)
                 )
 
             Output.Ast modules

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -117,9 +117,7 @@ module internal JsonSerializeGenerator =
                         SynExpr.CreateIdentString "arr"
                     ],
                 range0,
-                {
-                    InKeyword = None
-                }
+                SynExprLetOrUseTrivia.empty
             )
             |> SynExpr.createLambda "field"
         | IDictionaryType (keyType, valueType)
@@ -188,9 +186,7 @@ module internal JsonSerializeGenerator =
                         SynExpr.CreateIdentString "ret"
                     ],
                 range0,
-                {
-                    InKeyword = None
-                }
+                SynExprLetOrUseTrivia.empty
             )
             |> SynExpr.createLambda "field"
         | _ ->
@@ -204,7 +200,7 @@ module internal JsonSerializeGenerator =
 
     /// propertyName is probably a string literal, but it could be a [<Literal>] variable
     /// `node.Add ({propertyName}, {toJsonNode})`
-    let createSerializeRhs (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
+    let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
         let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
 
         let args =
@@ -219,7 +215,24 @@ module internal JsonSerializeGenerator =
 
         SynExpr.CreateApp (func, args)
 
-    let createMaker (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
+    let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr =
+        let propertyNameAttr =
+            attrs
+            |> List.tryFind (fun attr -> attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal))
+
+        match propertyNameAttr with
+        | None ->
+            let sb = StringBuilder fieldId.idText.Length
+            sb.Append (Char.ToLowerInvariant fieldId.idText.[0]) |> ignore
+
+            if fieldId.idText.Length > 1 then
+                sb.Append fieldId.idText.[1..] |> ignore
+
+            sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
+        | Some name -> name.ArgExpr
+
+
+    let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
         let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
 
         let returnInfo =
@@ -253,7 +266,7 @@ module internal JsonSerializeGenerator =
                 thisIdOpt
             )
 
-        let assignments =
+        let fields =
             fields
             |> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
                 let id =
@@ -261,26 +274,14 @@ module internal JsonSerializeGenerator =
                     | None -> failwith "didn't get an ID on field"
                     | Some id -> id
 
+                attrs, id, fieldType
+            )
+
+        let assignments =
+            fields
+            |> List.map (fun (attrs, id, fieldType) ->
                 let attrs = attrs |> List.collect (fun l -> l.Attributes)
 
-                let propertyNameAttr =
-                    attrs
-                    |> List.tryFind (fun attr ->
-                        attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
-                    )
-
-                let propertyName =
-                    match propertyNameAttr with
-                    | None ->
-                        let sb = StringBuilder id.idText.Length
-                        sb.Append (Char.ToLowerInvariant id.idText.[0]) |> ignore
-
-                        if id.idText.Length > 1 then
-                            sb.Append id.idText.[1..] |> ignore
-
-                        sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
-                    | Some name -> name.ArgExpr
-
                 let pattern =
                     SynPat.LongIdent (
                         SynLongIdent.CreateFromLongIdent [ id ],
@@ -291,17 +292,14 @@ module internal JsonSerializeGenerator =
                         range0
                     )
 
-                createSerializeRhs propertyName id fieldType
+                let propertyName = getPropertyName id attrs
+
+                createSerializeRhsRecord propertyName id fieldType
             )
 
         let finalConstruction =
             fields
-            |> List.map (fun (SynField (_, _, id, _, _, _, _, _, _)) ->
-                let id =
-                    match id with
-                    | None -> failwith "Expected record field to have an identifying name"
-                    | Some id -> id
-
+            |> List.map (fun (_, id, _) ->
                 (SynLongIdent.CreateFromLongIdent [ id ], true),
                 Some (SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ id ]))
             )
@@ -331,9 +329,7 @@ module internal JsonSerializeGenerator =
                         SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
                     ],
                 range0,
-                {
-                    InKeyword = None
-                }
+                SynExprLetOrUseTrivia.empty
             )
 
         let pattern =
@@ -406,7 +402,247 @@ module internal JsonSerializeGenerator =
 
             SynModuleDecl.CreateLet [ binding ]
 
-    let createRecordModule
+    let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
+        let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
+
+        let returnInfo =
+            SynBindingReturnInfo.Create (
+                SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
+            )
+
+        let inputArg = Ident.Create "input"
+        let functionName = Ident.Create "toJsonNode"
+
+        let inputVal =
+            let memberFlags =
+                if spec.ExtensionMethods then
+                    {
+                        SynMemberFlags.IsInstance = false
+                        SynMemberFlags.IsDispatchSlot = false
+                        SynMemberFlags.IsOverrideOrExplicitImpl = false
+                        SynMemberFlags.IsFinal = false
+                        SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
+                        SynMemberFlags.MemberKind = SynMemberKind.Member
+                    }
+                    |> Some
+                else
+                    None
+
+            let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg
+
+            SynValData.SynValData (
+                memberFlags,
+                SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
+                thisIdOpt
+            )
+
+        let cases =
+            cases
+            |> List.map (fun (SynUnionCase (attrs, SynIdent.SynIdent (id, _), caseType, _, _, _, _)) ->
+                match caseType with
+                | SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
+                | SynUnionCaseKind.Fields fields ->
+
+                let fields =
+                    fields
+                    |> List.map (fun (SynField (attrs, _, id, fieldType, _, _, _, _, _)) ->
+                        match id with
+                        | None -> failwith "WoofWare.Myriad requires all union fields to have names"
+                        | Some id ->
+
+                        let attrs = attrs |> List.collect (fun l -> l.Attributes)
+                        attrs, id, fieldType
+                    )
+                // As far as I can tell, there's no way to get any attributes here? :shrug:
+                let attrs = attrs |> List.collect (fun l -> l.Attributes)
+                attrs, id, fields
+            )
+
+        let matchClauses : SynMatchClause list =
+            cases
+            |> List.map (fun (attrs, id, caseType) ->
+                let propertyName = getPropertyName id attrs
+
+                let caseNames = caseType |> List.mapi (fun i _ -> Ident.Create $"arg%i{i}")
+
+                let argPats = SynArgPats.create caseNames
+
+                let pattern =
+                    SynPat.LongIdent (
+                        SynLongIdent.CreateFromLongIdent (typeName @ [ id ]),
+                        None,
+                        None,
+                        argPats,
+                        None,
+                        range0
+                    )
+
+                let typeLine =
+                    let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
+
+                    let args =
+                        SynExpr.CreateParenedTuple
+                            [
+                                SynExpr.CreateConstString "type"
+                                SynExpr.CreateApp (
+                                    SynExpr.CreateLongIdent (
+                                        SynLongIdent.CreateString "System.Text.Json.Nodes.JsonValue.Create"
+                                    ),
+                                    propertyName
+                                )
+                            ]
+
+                    SynExpr.CreateApp (func, args)
+
+                let dataNode =
+                    SynBinding.Let (
+                        pattern = SynPat.CreateNamed (Ident.Create "dataNode"),
+                        expr =
+                            SynExpr.CreateApp (
+                                SynExpr.CreateLongIdent (
+                                    SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
+                                ),
+                                SynExpr.CreateConst SynConst.Unit
+                            )
+                    )
+
+                let dataBindings =
+                    (caseType, caseNames)
+                    ||> List.zip
+                    |> List.map (fun ((attrs, ident, synType), caseName) ->
+                        let propertyName = getPropertyName ident attrs
+                        let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "dataNode" ; "Add" ])
+                        let node = SynExpr.CreateApp (serializeNode synType, SynExpr.CreateIdent caseName)
+
+                        SynExpr.CreateApp (func, SynExpr.CreateParenedTuple [ propertyName ; node ])
+                    )
+
+                let assignToNode =
+                    let func = SynExpr.CreateLongIdent (SynLongIdent.Create [ "node" ; "Add" ])
+
+                    let args =
+                        SynExpr.CreateParenedTuple
+                            [ SynExpr.CreateConstString "data" ; SynExpr.CreateIdentString "dataNode" ]
+
+                    SynExpr.CreateApp (func, args)
+
+                let dataNode =
+                    SynExpr.LetOrUse (
+                        false,
+                        false,
+                        [ dataNode ],
+                        SynExpr.CreateSequential (dataBindings @ [ assignToNode ]),
+                        range0,
+                        SynExprLetOrUseTrivia.empty
+                    )
+
+                let action =
+                    [
+                        yield typeLine
+                        if not dataBindings.IsEmpty then
+                            yield dataNode
+                    ]
+                    |> SynExpr.CreateSequential
+
+                SynMatchClause.Create (pattern, None, action)
+            )
+
+        let assignments =
+            SynExpr.LetOrUse (
+                false,
+                false,
+                [
+                    SynBinding.Let (
+                        pattern = SynPat.CreateNamed (Ident.Create "node"),
+                        expr =
+                            SynExpr.CreateApp (
+                                SynExpr.CreateLongIdent (
+                                    SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
+                                ),
+                                SynExpr.CreateConst SynConst.Unit
+                            )
+                    )
+                ],
+                SynExpr.CreateSequential
+                    [
+                        SynExpr.CreateMatch (SynExpr.CreateIdent inputArg, matchClauses)
+                        SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
+                    ],
+                range0,
+                SynExprLetOrUseTrivia.empty
+            )
+
+        let pattern =
+            SynPat.LongIdent (
+                SynLongIdent.CreateFromLongIdent [ functionName ],
+                None,
+                None,
+                SynArgPats.Pats
+                    [
+                        SynPat.CreateTyped (
+                            SynPat.CreateNamed inputArg,
+                            SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
+                        )
+                        |> SynPat.CreateParen
+                    ],
+                None,
+                range0
+            )
+
+        if spec.ExtensionMethods then
+            let binding =
+                SynBinding.SynBinding (
+                    None,
+                    SynBindingKind.Normal,
+                    false,
+                    false,
+                    [],
+                    xmlDoc,
+                    inputVal,
+                    pattern,
+                    Some returnInfo,
+                    assignments,
+                    range0,
+                    DebugPointAtBinding.NoneAtInvisible,
+                    {
+                        LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
+                        InlineKeyword = None
+                        EqualsRange = Some range0
+                    }
+                )
+
+            let mem = SynMemberDefn.Member (binding, range0)
+
+            let containingType =
+                SynTypeDefn.SynTypeDefn (
+                    SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create " Extension methods for JSON parsing"),
+                    SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
+                    [ mem ],
+                    None,
+                    range0,
+                    {
+                        LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
+                        EqualsRange = None
+                        WithKeyword = None
+                    }
+                )
+
+            SynModuleDecl.Types ([ containingType ], range0)
+        else
+            let binding =
+                SynBinding.Let (
+                    isInline = false,
+                    isMutable = false,
+                    xmldoc = xmlDoc,
+                    returnInfo = returnInfo,
+                    expr = assignments,
+                    valData = inputVal,
+                    pattern = pattern
+                )
+
+            SynModuleDecl.CreateLet [ binding ]
+
+    let createModule
         (namespaceId : LongIdent)
         (opens : SynOpenDeclTarget list)
         (spec : JsonSerializeOutputSpec)
@@ -415,60 +651,62 @@ module internal JsonSerializeGenerator =
         let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
             typeDefn
 
-        let (SynComponentInfo (_attributes, _typeParams, _constraints, recordId, _, _preferPostfix, _access, _)) =
+        let (SynComponentInfo (_attributes, _typeParams, _constraints, ident, _, _preferPostfix, _access, _)) =
             synComponentInfo
 
-        match synTypeDefnRepr with
-        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
+        let attributes =
+            if spec.ExtensionMethods then
+                [ SynAttributeList.Create SynAttribute.autoOpen ]
+            else
+                [
+                    SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
+                    SynAttributeList.Create SynAttribute.compilationRepresentation
+                ]
 
-            let decls = [ createMaker spec recordId recordFields ]
+        let xmlDoc =
+            let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "."
 
-            let attributes =
+            let description =
                 if spec.ExtensionMethods then
-                    [ SynAttributeList.Create SynAttribute.autoOpen ]
+                    "extension members"
                 else
-                    [
-                        SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
-                        SynAttributeList.Create SynAttribute.compilationRepresentation
-                    ]
+                    "methods"
 
-            let xmlDoc =
-                let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "."
+            $" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
+            |> PreXmlDoc.Create
 
-                let description =
-                    if spec.ExtensionMethods then
-                        "extension members"
-                    else
-                        "methods"
+        let moduleName =
+            if spec.ExtensionMethods then
+                match ident with
+                | [] -> failwith "unexpectedly got an empty identifier for type name"
+                | ident ->
+                    let expanded =
+                        List.last ident
+                        |> fun i -> i.idText
+                        |> fun s -> s + "JsonSerializeExtension"
+                        |> Ident.Create
 
-                $" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
-                |> PreXmlDoc.Create
+                    List.take (List.length ident - 1) ident @ [ expanded ]
+            else
+                ident
 
-            let moduleName =
-                if spec.ExtensionMethods then
-                    match recordId with
-                    | [] -> failwith "unexpectedly got an empty identifier for record name"
-                    | recordId ->
-                        let expanded =
-                            List.last recordId
-                            |> fun i -> i.idText
-                            |> fun s -> s + "JsonSerializeExtension"
-                            |> Ident.Create
+        let info =
+            SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
 
-                        List.take (List.length recordId - 1) recordId @ [ expanded ]
-                else
-                    recordId
+        let decls =
+            match synTypeDefnRepr with
+            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _range), _) ->
+                [ recordModule spec ident recordFields ]
+            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, unionFields, _range), _) ->
+                [ unionModule spec ident unionFields ]
+            | _ -> failwithf "Only record types currently supported."
 
-            let info =
-                SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
+        let mdl = SynModuleDecl.CreateNestedModule (info, decls)
 
-            let mdl = SynModuleDecl.CreateNestedModule (info, decls)
-
-            SynModuleOrNamespace.CreateNamespace (
-                namespaceId,
-                decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
-            )
-        | _ -> failwithf "Not a record type"
+        SynModuleOrNamespace.CreateNamespace (
+            namespaceId,
+            decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
+        )
 
 /// Myriad generator that provides a method (possibly an extension method) for a record type,
 /// containing a JSON serialization function.
@@ -482,10 +720,20 @@ type JsonSerializeGenerator () =
             let ast, _ =
                 Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
 
-            let records = Ast.extractRecords ast
+            let recordsAndUnions =
+                Ast.extractTypeDefn 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
+                        else None
+                    )
+                    |> fun defns -> name, defns
+                )
 
-            let namespaceAndRecords =
-                records
+            let namespaceAndTypes =
+                recordsAndUnions
                 |> List.choose (fun (ns, types) ->
                     types
                     |> List.choose (fun typeDef ->
@@ -515,13 +763,10 @@ type JsonSerializeGenerator () =
             let opens = AstHelper.extractOpens ast
 
             let modules =
-                namespaceAndRecords
-                |> List.collect (fun (ns, records) ->
-                    records
-                    |> List.map (fun (record, spec) ->
-                        let recordModule = JsonSerializeGenerator.createRecordModule ns opens spec record
-                        recordModule
-                    )
+                namespaceAndTypes
+                |> List.collect (fun (ns, types) ->
+                    types
+                    |> List.map (fun (ty, spec) -> JsonSerializeGenerator.createModule ns opens spec ty)
                 )
 
             Output.Ast modules

WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs

@@ -0,0 +1,18 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.Syntax
+open Fantomas.FCS.Text.Range
+
+[<RequireQualifiedAccess>]
+module internal SynArgPats =
+    let create (caseNames : Ident list) : SynArgPats =
+        if caseNames.IsEmpty then
+            SynArgPats.Pats []
+        else
+
+        caseNames
+        |> List.map (fun ident -> SynPat.Named (SynIdent.SynIdent (ident, None), false, None, range0))
+        |> fun ps -> SynPat.Tuple (false, ps, List.replicate (ps.Length - 1) range0, range0)
+        |> fun p -> SynPat.Paren (p, range0)
+        |> List.singleton
+        |> SynArgPats.Pats

WoofWare.Myriad.Plugins/SynExpr/SynExprLetOrUseTrivia.fs

@@ -0,0 +1,10 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.SyntaxTrivia
+
+[<RequireQualifiedAccess>]
+module internal SynExprLetOrUseTrivia =
+    let empty : SynExprLetOrUseTrivia =
+        {
+            InKeyword = None
+        }

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

@@ -27,9 +27,11 @@
     <Compile Include="List.fs"/>
     <Compile Include="Ident.fs" />
     <Compile Include="AstHelper.fs"/>
-    <Compile Include="SynExpr.fs" />
-    <Compile Include="SynType.fs"/>
-    <Compile Include="SynAttribute.fs"/>
+    <Compile Include="SynExpr\SynExpr.fs" />
+    <Compile Include="SynExpr\SynType.fs" />
+    <Compile Include="SynExpr\SynAttribute.fs" />
+    <Compile Include="SynExpr\SynArgPats.fs" />
+    <Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
     <Compile Include="RemoveOptionsGenerator.fs"/>
     <Compile Include="InterfaceMockGenerator.fs"/>
     <Compile Include="JsonSerializeGenerator.fs"/>