Fix record/union impl accessibility (#245)

ConsumePlugin/Args.fs

@@ -178,3 +178,20 @@ type ContainsFlagDefaultValue =
     }
 
     static member DefaultDryRun () = DryRunMode.Wet
+
+[<ArgParser true>]
+type ManyLongForms =
+    {
+        [<ArgumentLongForm "do-something-else">]
+        [<ArgumentLongForm "anotherarg">]
+        DoTheThing : string
+
+        [<ArgumentLongForm "turn-it-on">]
+        [<ArgumentLongForm "dont-turn-it-off">]
+        SomeFlag : bool
+    }
+
+[<RequireQualifiedAccess>]
+type private IrrelevantDu =
+    | Foo
+    | Bar

WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs

@@ -70,3 +70,15 @@ type InvariantCultureAttribute () =
 /// You must put this attribute on both cases of the discriminated union, with opposite values in each case.
 type ArgumentFlagAttribute (flagValue : bool) =
     inherit Attribute ()
+
+/// Attribute placed on a field of a record to specify a different long form from the default. If you place this
+/// attribute, you won't get the default: ArgFoo would normally be expressed as `--arg-foo`, but if you instead
+/// say `[<ArgumentLongForm "thingy-blah">]` or `[<ArgumentLongForm "thingy">]`, you instead use `--thingy-blah`
+/// or `--thingy` respectively.
+///
+/// You can place this argument multiple times.
+///
+/// Omit the initial `--` that you expect the user to type.
+[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
+type ArgumentLongForm (s : string) =
+    inherit Attribute ()

WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt

@@ -11,6 +11,8 @@ WoofWare.Myriad.Plugins.ArgumentFlagAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ArgumentFlagAttribute..ctor [constructor]: bool
 WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute..ctor [constructor]: string
+WoofWare.Myriad.Plugins.ArgumentLongForm inherit System.Attribute
+WoofWare.Myriad.Plugins.ArgumentLongForm..ctor [constructor]: string
 WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute

WoofWare.Myriad.Plugins.Attributes/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "3.3",
+  "version": "3.4",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],

WoofWare.Myriad.Plugins.Test/TestArgParser/TestArgParser.fs

@@ -550,3 +550,71 @@ Required argument '--exact' received no value"""
         |> shouldEqual
             """Help text requested.
 --dry-run  bool"""
+
+    let longFormCases =
+        let doTheThing =
+            [
+                [ "--do-something-else=foo" ]
+                [ "--anotherarg=foo" ]
+                [ "--do-something-else" ; "foo" ]
+                [ "--anotherarg" ; "foo" ]
+            ]
+
+        let someFlag =
+            [
+                [ "--turn-it-on" ], true
+                [ "--dont-turn-it-off" ], true
+                [ "--turn-it-on=true" ], true
+                [ "--dont-turn-it-off=true" ], true
+                [ "--turn-it-on=false" ], false
+                [ "--dont-turn-it-off=false" ], false
+                [ "--turn-it-on" ; "true" ], true
+                [ "--dont-turn-it-off" ; "true" ], true
+                [ "--turn-it-on" ; "false" ], false
+                [ "--dont-turn-it-off" ; "false" ], false
+            ]
+
+        List.allPairs doTheThing someFlag
+        |> List.map (fun (doTheThing, (someFlag, someFlagResult)) ->
+            let args = doTheThing @ someFlag
+
+            let expected =
+                {
+                    DoTheThing = "foo"
+                    SomeFlag = someFlagResult
+                }
+
+            args, expected
+        )
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof longFormCases)>]
+    let ``Long-form args`` (args : string list, expected : ManyLongForms) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ManyLongForms.parse' getEnvVar args |> shouldEqual expected
+
+    [<Test>]
+    let ``Long-form args can't be referred to by their original name`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                ManyLongForms.parse' getEnvVar [ "--do-the-thing=foo" ] |> ignore<ManyLongForms>
+            )
+
+        exc.Message
+        |> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
+
+    [<Test>]
+    let ``Long-form args help text`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () -> ManyLongForms.parse' getEnvVar [ "--help" ] |> ignore<ManyLongForms>)
+
+        exc.Message
+        |> shouldEqual
+            """Help text requested.
+--do-something-else / --anotherarg  string
+--turn-it-on / --dont-turn-it-off  bool"""

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -50,7 +50,11 @@ type private ParseFunction<'acc> =
     {
         FieldName : Ident
         TargetVariable : Ident
-        ArgForm : string
+        /// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might
+        /// get confused with positional args or something! I haven't thought that hard about this.
+        /// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have
+        /// omitted the initial `--` that will be required at runtime.
+        ArgForm : SynExpr list
         /// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different:
         /// we should lie to the user about the value of the cases there.
         /// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g.
@@ -70,6 +74,15 @@ type private ParseFunction<'acc> =
         Accumulation : 'acc
     }
 
+    /// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all
+    /// the ways they can refer to this arg.
+    member arg.HumanReadableArgForm : SynExpr =
+        let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
+
+        (SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
+        ||> List.fold SynExpr.applyFunction
+        |> SynExpr.paren
+
 [<RequireQualifiedAccess>]
 type private ChoicePositional =
     | Normal
@@ -210,7 +223,15 @@ module private ParseTree =
 
         |> fun (nonPos, pos) ->
             let duplicateArgs =
+                // This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings.
                 Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm)
+                |> Seq.concat
+                |> Seq.choose (fun expr ->
+                    match expr |> SynExpr.stripOptionalParen with
+                    | SynExpr.Const (SynConst.String (s, _, _), _) -> Some s
+                    | _ -> None
+                )
+                |> List.ofSeq
                 |> List.groupBy id
                 |> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None)
 
@@ -251,7 +272,6 @@ module internal ArgParserGenerator =
     /// Convert e.g. "Foo" into "--foo".
     let argify (ident : Ident) : string =
         let result = StringBuilder ()
-        result.Append "-" |> ignore<StringBuilder>
 
         for c in ident.idText do
             if Char.IsUpper c then
@@ -259,7 +279,7 @@ module internal ArgParserGenerator =
             else
                 result.Append c |> ignore<StringBuilder>
 
-        result.ToString ()
+        result.ToString().TrimStart '-'
 
     let private identifyAsFlag (flagDus : FlagDu list) (ty : SynType) : FlagDu option =
         match ty with
@@ -531,6 +551,20 @@ module internal ArgParserGenerator =
                     | None -> failwith "expected args field to have a name, but it did not"
                     | Some i -> i
 
+                let longForms =
+                    attrs
+                    |> List.choose (fun attr ->
+                        match attr.TypeName with
+                        | SynLongIdent.SynLongIdent (ident, _, _) ->
+                            if (List.last ident).idText = "ArgumentLongForm" then
+                                Some attr.ArgExpr
+                            else
+                                None
+                    )
+                    |> function
+                        | [] -> List.singleton (SynExpr.CreateConst (argify ident))
+                        | l -> List.ofSeq l
+
                 let ambientRecordMatch =
                     match fieldType with
                     | SynType.LongIdent (SynLongIdent.SynLongIdent (id, _, _)) ->
@@ -575,7 +609,7 @@ module internal ArgParserGenerator =
                             TargetVariable = Ident.create $"arg_%i{counter}"
                             Accumulation = ChoicePositional.Choice
                             TargetType = parseTy
-                            ArgForm = argify ident
+                            ArgForm = longForms
                             Help = helpText
                             BoolCases = isBoolLike
                         }
@@ -587,7 +621,7 @@ module internal ArgParserGenerator =
                             TargetVariable = Ident.create $"arg_%i{counter}"
                             Accumulation = ChoicePositional.Normal
                             TargetType = parseTy
-                            ArgForm = argify ident
+                            ArgForm = longForms
                             Help = helpText
                             BoolCases = isBoolLike
                         }
@@ -620,7 +654,7 @@ module internal ArgParserGenerator =
                         TargetVariable = Ident.create $"arg_%i{counter}"
                         Accumulation = accumulation
                         TargetType = parseTy
-                        ArgForm = argify ident
+                        ArgForm = longForms
                         Help = helpText
                         BoolCases = isBoolLike
                     }
@@ -715,9 +749,8 @@ module internal ArgParserGenerator =
 
             let descriptor = describe arg.Accumulation arg.BoolCases
 
-            let prefix = $"%s{arg.ArgForm}  %s{ty}"
-
-            SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst (prefix + "%s%s"))
+            SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst $"%%s  %s{ty}%%s%%s")
+            |> SynExpr.applyTo arg.HumanReadableArgForm
             |> SynExpr.applyTo descriptor
             |> SynExpr.applyTo helpText
             |> SynExpr.paren
@@ -754,7 +787,7 @@ module internal ArgParserGenerator =
                     let multipleErrorMessage =
                         SynExpr.createIdent "sprintf"
                         |> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %O and %O")
-                        |> SynExpr.applyTo (SynExpr.CreateConst arg.ArgForm)
+                        |> SynExpr.applyTo arg.HumanReadableArgForm
                         |> SynExpr.applyTo (SynExpr.createIdent "x")
                         |> SynExpr.applyTo (SynExpr.createIdent "value")
 
@@ -830,17 +863,24 @@ module internal ArgParserGenerator =
 
         (SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), posArg @ args)
         ||> List.fold (fun finalBranch (argForm, arg) ->
-            arg
-            |> SynExpr.ifThenElse
-                (SynExpr.applyFunction
-                    (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
-                    (SynExpr.tuple
-                        [
-                            SynExpr.createIdent "key"
-                            SynExpr.CreateConst argForm
-                            SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
-                        ]))
-                finalBranch
+            (finalBranch, argForm)
+            ||> List.fold (fun finalBranch argForm ->
+                arg
+                |> SynExpr.ifThenElse
+                    (SynExpr.applyFunction
+                        (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                        (SynExpr.tuple
+                            [
+                                SynExpr.createIdent "key"
+                                SynExpr.applyFunction
+                                    (SynExpr.applyFunction
+                                        (SynExpr.createIdent "sprintf")
+                                        (SynExpr.CreateConst "--%s"))
+                                    argForm
+                                SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                            ]))
+                    finalBranch
+            )
         )
         |> SynBinding.basic
             [ Ident.create "processKeyValue" ]
@@ -870,40 +910,52 @@ module internal ArgParserGenerator =
             let multipleErrorMessage =
                 SynExpr.createIdent "sprintf"
                 |> SynExpr.applyTo (SynExpr.CreateConst "Flag '%s' was supplied multiple times")
-                |> SynExpr.applyTo (SynExpr.CreateConst flag.ArgForm)
+                |> SynExpr.applyTo flag.HumanReadableArgForm
 
-            [
-                SynMatchClause.create
-                    (SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
-                    // This is an error, but it's one we can gracefully report at the end.
-                    (SynExpr.sequential
-                        [
-                            multipleErrorMessage
-                            |> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors))
+            let matchFlag =
+                [
+                    SynMatchClause.create
+                        (SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
+                        // This is an error, but it's one we can gracefully report at the end.
+                        (SynExpr.sequential
+                            [
+                                multipleErrorMessage
+                                |> SynExpr.pipeThroughFunction (
+                                    SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
+                                )
+                                SynExpr.CreateConst true
+                            ])
+
+                    SynMatchClause.create
+                        (SynPat.named "None")
+                        ([
+                            SynExpr.assign
+                                (SynLongIdent.createI flag.TargetVariable)
+                                (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase)
                             SynExpr.CreateConst true
-                        ])
+                         ]
+                         |> SynExpr.sequential)
+                ]
+                |> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
 
-                SynMatchClause.create
-                    (SynPat.named "None")
-                    ([
-                        SynExpr.assign
-                            (SynLongIdent.createI flag.TargetVariable)
-                            (SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") trueCase)
-                        SynExpr.CreateConst true
-                     ]
-                     |> SynExpr.sequential)
-            ]
-            |> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
-            |> SynExpr.ifThenElse
-                (SynExpr.applyFunction
-                    (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
-                    (SynExpr.tuple
-                        [
-                            SynExpr.createIdent "key"
-                            SynExpr.CreateConst flag.ArgForm
-                            SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
-                        ]))
-                finalExpr
+            (finalExpr, flag.ArgForm)
+            ||> List.fold (fun finalExpr argForm ->
+                SynExpr.ifThenElse
+                    (SynExpr.applyFunction
+                        (SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
+                        (SynExpr.tuple
+                            [
+                                SynExpr.createIdent "key"
+                                SynExpr.applyFunction
+                                    (SynExpr.applyFunction
+                                        (SynExpr.createIdent "sprintf")
+                                        (SynExpr.CreateConst "--%s"))
+                                    argForm
+                                SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
+                            ]))
+                    finalExpr
+                    matchFlag
+            )
         )
         |> SynBinding.basic [ Ident.create "setFlagValue" ] [ SynPat.annotateType SynType.string (SynPat.named "key") ]
         |> SynBinding.withReturnAnnotation (SynType.named "bool")
@@ -1289,7 +1341,7 @@ module internal ArgParserGenerator =
                                     SynExpr.CreateConst
                                         "No value was supplied for %s, nor was environment variable %s set"
                                 )
-                                |> SynExpr.applyTo (SynExpr.CreateConst pf.ArgForm)
+                                |> SynExpr.applyTo pf.HumanReadableArgForm
                                 |> SynExpr.applyTo name
 
                             [
@@ -1338,7 +1390,7 @@ module internal ArgParserGenerator =
                     let errorMessage =
                         SynExpr.createIdent "sprintf"
                         |> SynExpr.applyTo (SynExpr.CreateConst "Required argument '%s' received no value")
-                        |> SynExpr.applyTo (SynExpr.CreateConst pf.ArgForm)
+                        |> SynExpr.applyTo pf.HumanReadableArgForm
 
                     [
                         SynMatchClause.create
@@ -1469,53 +1521,54 @@ module internal ArgParserGenerator =
             |> List.choose (fun ty ->
                 match ty.Cases with
                 | [ c1 ; c2 ] ->
+                    let c1Attr =
+                        c1.Attributes
+                        |> List.tryPick (fun attr ->
+                            match attr.TypeName with
+                            | SynLongIdent.SynLongIdent (id, _, _) ->
+                                match id |> List.last |> _.idText with
+                                | "ArgumentFlagAttribute"
+                                | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
+                                | _ -> None
+                        )
+
+                    let c2Attr =
+                        c2.Attributes
+                        |> List.tryPick (fun attr ->
+                            match attr.TypeName with
+                            | SynLongIdent.SynLongIdent (id, _, _) ->
+                                match id |> List.last |> _.idText with
+                                | "ArgumentFlagAttribute"
+                                | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
+                                | _ -> None
+                        )
+
+                    match c1Attr, c2Attr with
+                    | Some _, None
+                    | None, Some _ ->
+                        failwith
+                            "[<ArgumentFlag>] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case."
+                    | None, None -> None
+                    | Some c1Attr, Some c2Attr ->
+
+                    // Sanity check where possible
+                    match c1Attr, c2Attr with
+                    | SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) ->
+                        if b1 = b2 then
+                            failwith
+                                "[<ArgumentFlag>] must have opposite argument values on each case in a two-case discriminated union."
+                    | _, _ -> ()
+
                     match c1.Fields, c2.Fields with
                     | [], [] ->
-                        let c1Attr =
-                            c1.Attributes
-                            |> List.tryPick (fun attr ->
-                                match attr.TypeName with
-                                | SynLongIdent.SynLongIdent (id, _, _) ->
-                                    match id |> List.last |> _.idText with
-                                    | "ArgumentFlagAttribute"
-                                    | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
-                                    | _ -> None
-                            )
-
-                        let c2Attr =
-                            c2.Attributes
-                            |> List.tryPick (fun attr ->
-                                match attr.TypeName with
-                                | SynLongIdent.SynLongIdent (id, _, _) ->
-                                    match id |> List.last |> _.idText with
-                                    | "ArgumentFlagAttribute"
-                                    | "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
-                                    | _ -> None
-                            )
-
-                        match c1Attr, c2Attr with
-                        | Some c1Attr, Some c2Attr ->
-                            // Sanity check where possible
-                            match c1Attr, c2Attr with
-                            | SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) ->
-                                if b1 = b2 then
-                                    failwith
-                                        "[<ArgumentFlag>] must have opposite argument values on each case in a two-case discriminated union."
-                            | _, _ -> ()
-
-                            {
-                                Name = ty.Name
-                                Case1Name = c1.Name
-                                Case1Arg = c1Attr
-                                Case2Name = c2.Name
-                                Case2Arg = c2Attr
-                            }
-                            |> Some
-                        | Some _, None
-                        | None, Some _ ->
-                            failwith
-                                "[<ArgumentFlag>] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case."
-                        | _, _ -> None
+                        {
+                            Name = ty.Name
+                            Case1Name = c1.Name
+                            Case1Arg = c1Attr
+                            Case2Name = c2.Name
+                            Case2Arg = c2Attr
+                        }
+                        |> Some
                     | _, _ ->
                         failwith "[<ArgumentFlag>] may only be placed on discriminated union members with no data."
                 | _ -> None

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -67,7 +67,8 @@ type internal RecordType =
         Members : SynMemberDefns option
         XmlDoc : PreXmlDoc option
         Generics : SynTyparDecls option
-        Accessibility : SynAccess option
+        TypeAccessibility : SynAccess option
+        ImplAccessibility : SynAccess option
         Attributes : SynAttribute list
     }
 
@@ -80,17 +81,15 @@ type internal RecordType =
         : RecordType
         =
         match sci with
-        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access2, _) ->
-            if access <> access2 then
-                failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
-
+        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
             {
                 Name = List.last longId
                 Fields = recordFields
                 Members = if smd.IsEmpty then None else Some smd
                 XmlDoc = if doc.IsEmpty then None else Some doc
                 Generics = typars
-                Accessibility = access
+                ImplAccessibility = implAccess
+                TypeAccessibility = access
                 Attributes = attrs |> List.collect (fun l -> l.Attributes)
             }
 
@@ -144,7 +143,9 @@ type internal UnionType =
         /// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
         Attributes : SynAttribute list
         /// Accessibility modifier of the DU: `type private Foo = ...`
-        Accessibility : SynAccess option
+        TypeAccessibility : SynAccess option
+        /// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
+        ImplAccessibility : SynAccess option
         /// The actual DU cases themselves.
         Cases : UnionCase<Ident option> list
     }
@@ -157,17 +158,15 @@ type internal UnionType =
         : UnionType
         =
         match sci with
-        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access2, _) ->
-            if access <> access2 then
-                failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
-
+        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
             {
                 Name = List.last longId
                 Members = if smd.IsEmpty then None else Some smd
                 XmlDoc = if doc.IsEmpty then None else Some doc
                 Generics = typars
                 Attributes = attrs |> List.collect (fun l -> l.Attributes)
-                Accessibility = access
+                TypeAccessibility = access
+                ImplAccessibility = implAccess
                 Cases = cases |> List.map UnionCase.ofSynUnionCase
             }
 
@@ -213,13 +212,13 @@ module internal AstHelper =
     let defineRecordType (record : RecordType) : SynTypeDefn =
         let name =
             SynComponentInfo.create record.Name
-            |> SynComponentInfo.setAccessibility record.Accessibility
+            |> SynComponentInfo.setAccessibility record.TypeAccessibility
             |> match record.XmlDoc with
                | None -> id
                | Some doc -> SynComponentInfo.withDocString doc
             |> SynComponentInfo.setGenerics record.Generics
 
-        SynTypeDefnRepr.record (Seq.toList record.Fields)
+        SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields)
         |> SynTypeDefn.create name
         |> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
 

WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs

@@ -212,7 +212,8 @@ module internal InterfaceMockGenerator =
                 Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
                 XmlDoc = Some xmlDoc
                 Generics = interfaceType.Generics
-                Accessibility = Some access
+                TypeAccessibility = Some access
+                ImplAccessibility = None
                 Attributes = []
             }
 

WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs

@@ -36,7 +36,6 @@ module internal RemoveOptionsGenerator =
             trivia
         )
 
-    // TODO: this option seems a bit odd
     let createType
         (xmlDoc : PreXmlDoc option)
         (accessibility : SynAccess option)
@@ -54,7 +53,8 @@ module internal RemoveOptionsGenerator =
                 Members = None
                 XmlDoc = xmlDoc
                 Generics = generics
-                Accessibility = accessibility
+                TypeAccessibility = accessibility
+                ImplAccessibility = None
                 Attributes = []
             }
 
@@ -62,7 +62,7 @@ module internal RemoveOptionsGenerator =
 
         SynModuleDecl.Types ([ typeDecl ], range0)
 
-    let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
+    let createMaker (withOptionsType : LongIdent) (withoutOptionsType : Ident) (fields : SynFieldData<Ident> list) =
         let xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
 
         let inputArg = Ident.create "input"
@@ -87,7 +87,7 @@ module internal RemoveOptionsGenerator =
                             SynExpr.applyFunction
                                 (SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
                                 (SynExpr.createLongIdent' (
-                                    withoutOptionsType
+                                    [ withoutOptionsType ]
                                     @ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
                                 ))
                         )
@@ -101,47 +101,35 @@ module internal RemoveOptionsGenerator =
             [ functionName ]
             [
                 SynPat.named inputArg.idText
-                |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
+                |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType))
             ]
             body
         |> SynBinding.withXmlDoc xmlDoc
         |> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
         |> SynModuleDecl.createLet
 
-    let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
-        let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
-            typeDefn
+    let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) =
+        let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent
 
-        let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
-            synComponentInfo
+        let decls =
+            [
+                createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields
+                createMaker [ Ident.create "Short" ] typeDefn.Name fieldData
+            ]
 
-        match synTypeDefnRepr with
-        | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
-            let fieldData = fields |> List.map SynField.extractWithIdent
+        let xmlDoc =
+            sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText
+            |> PreXmlDoc.create
 
-            let decls =
-                [
-                    createType (Some doc) accessibility typeParams fields
-                    createMaker [ Ident.create "Short" ] recordId fieldData
-                ]
+        let info =
+            SynComponentInfo.create typeDefn.Name
+            |> SynComponentInfo.withDocString xmlDoc
+            |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
+            |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
 
-            let xmlDoc =
-                recordId
-                |> Seq.map (fun i -> i.idText)
-                |> String.concat "."
-                |> sprintf "Module containing an option-truncated version of the %s type"
-                |> PreXmlDoc.create
-
-            let info =
-                SynComponentInfo.createLong recordId
-                |> SynComponentInfo.withDocString xmlDoc
-                |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
-                |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
-
-            SynModuleDecl.nestedModule info decls
-            |> List.singleton
-            |> SynModuleOrNamespace.createNamespace namespaceId
-        | _ -> failwithf "Not a record type"
+        SynModuleDecl.nestedModule info decls
+        |> List.singleton
+        |> SynModuleOrNamespace.createNamespace namespaceId
 
 open Myriad.Core
 
@@ -164,7 +152,24 @@ type RemoveOptionsGenerator () =
                 |> List.choose (fun (ns, types) ->
                     match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
                     | [] -> None
-                    | types -> Some (ns, types)
+                    | 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)
                 )
 
             let modules =

WoofWare.Myriad.Plugins/SynExpr/SynTypeDefnRepr.fs

@@ -13,8 +13,12 @@ module internal SynTypeDefnRepr =
     let inline augmentation () : SynTypeDefnRepr =
         SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
 
-    let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
-        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
+    let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
+        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
 
-    let inline record (fields : SynField list) : SynTypeDefnRepr =
-        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
+    let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
+
+    let inline recordWithAccess (implAccess : SynAccess option) (fields : SynField list) : SynTypeDefnRepr =
+        SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (implAccess, fields, range0), range0)
+
+    let inline record (fields : SynField list) : SynTypeDefnRepr = recordWithAccess None fields