Cope with unit type in JSON (#262)

* Bump Microsoft.NET.Test.Sdk from 17.11.0 to 17.11.1

Bumps [Microsoft.NET.Test.Sdk](https://github.com/microsoft/vstest) from 17.11.0 to 17.11.1.
- [Release notes](https://github.com/microsoft/vstest/releases)
- [Changelog](https://github.com/microsoft/vstest/blob/main/docs/releases.md)
- [Commits](https://github.com/microsoft/vstest/compare/v17.11.0...v17.11.1)

---
updated-dependencies:
- dependency-name: Microsoft.NET.Test.Sdk
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Bump fantomas from 6.3.11 to 6.3.12

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.11 to 6.3.12.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.11...v6.3.12)

---
updated-dependencies:
- dependency-name: fantomas
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>

.config/dotnet-tools.json

@@ -3,7 +3,7 @@
   "isRoot": true,
   "tools": {
     "fantomas": {
-      "version": "6.3.11",
+      "version": "6.3.12",
       "commands": [
         "fantomas"
       ]

.github/workflows/dotnet.yaml

@@ -241,7 +241,7 @@ jobs:
           name: nuget-package-attribute
           path: packed
       - name: Attest Build Provenance
-        uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
+        uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
         with:
           subject-path: "packed/*.nupkg"
 
@@ -260,7 +260,7 @@ jobs:
           name: nuget-package-plugin
           path: packed
       - name: Attest Build Provenance
-        uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
+        uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
         with:
           subject-path: "packed/*.nupkg"
 

.gitignore

@@ -11,3 +11,4 @@ result
 analysis.sarif
 .direnv/
 .venv/
+.vs/

ConsumePlugin/Args.fs

@@ -111,7 +111,7 @@ type ChildRecordWithPositional =
     {
         Thing1 : int
         [<PositionalArgs>]
-        Thing2 : string list
+        Thing2 : Uri list
     }
 
 [<ArgParser true>]
@@ -128,3 +128,110 @@ type ParentRecordSelfPos =
         [<PositionalArgs>]
         AndAnother : bool list
     }
+
+[<ArgParser true>]
+type ChoicePositionals =
+    {
+        [<PositionalArgs>]
+        Args : Choice<string, string> list
+    }
+
+[<ArgParser true>]
+type ContainsBoolEnvVar =
+    {
+        [<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
+        BoolVar : Choice<bool, bool>
+    }
+
+[<RequireQualifiedAccess>]
+module Consts =
+    [<Literal>]
+    let FALSE = false
+
+    [<Literal>]
+    let TRUE = true
+
+type DryRunMode =
+    | [<ArgumentFlag(Consts.FALSE)>] Wet
+    | [<ArgumentFlag true>] Dry
+
+[<ArgParser true>]
+type WithFlagDu =
+    {
+        DryRun : DryRunMode
+    }
+
+[<ArgParser true>]
+type ContainsFlagEnvVar =
+    {
+        // This phrasing is odd, but it's for a test. Nobody's really going to have `--dry-run`
+        // controlled by an env var!
+        [<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
+        DryRun : Choice<DryRunMode, DryRunMode>
+    }
+
+[<ArgParser true>]
+type ContainsFlagDefaultValue =
+    {
+        [<ArgumentDefaultFunction>]
+        DryRun : Choice<DryRunMode, DryRunMode>
+    }
+
+    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
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgs =
+    {
+        A : string
+        [<PositionalArgs true>]
+        GrabEverything : string list
+    }
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgsChoice =
+    {
+        A : string
+        [<PositionalArgs true>]
+        GrabEverything : Choice<string, string> list
+    }
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgsInt =
+    {
+        A : string
+        [<PositionalArgs true>]
+        GrabEverything : int list
+    }
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgsIntChoice =
+    {
+        A : string
+        [<PositionalArgs true>]
+        GrabEverything : Choice<int, int> list
+    }
+
+[<ArgParser true>]
+type FlagsIntoPositionalArgs' =
+    {
+        A : string
+        [<PositionalArgs false>]
+        DontGrabEverything : string list
+    }

ConsumePlugin/GeneratedSerde.fs

@@ -210,6 +210,8 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
                      |> (fun field -> field.ToString "o" |> System.Text.Json.Nodes.JsonValue.Create<string>))
                 )
 
+                node.Add ("unit", (input.Unit |> (fun value -> System.Text.Json.Nodes.JsonObject ())))
+
             node :> _
 namespace ConsumePlugin
 
@@ -291,6 +293,60 @@ module FooJsonSerializeExtension =
                 )
 
             node :> _
+namespace ConsumePlugin
+
+open System
+open System.Collections.Generic
+open System.Text.Json.Serialization
+
+/// Module containing JSON serializing extension members for the CollectRemaining type
+[<AutoOpen>]
+module CollectRemainingJsonSerializeExtension =
+    /// Extension methods for JSON parsing
+    type CollectRemaining with
+
+        /// Serialize to a JSON node
+        static member toJsonNode (input : CollectRemaining) : System.Text.Json.Nodes.JsonNode =
+            let node = System.Text.Json.Nodes.JsonObject ()
+
+            do
+                node.Add (
+                    "message",
+                    (input.Message
+                     |> (fun field ->
+                         match field with
+                         | None -> null :> System.Text.Json.Nodes.JsonNode
+                         | Some field -> HeaderAndValue.toJsonNode field
+                     ))
+                )
+
+                for KeyValue (key, value) in input.Rest do
+                    node.Add (key, id value)
+
+            node :> _
+namespace ConsumePlugin
+
+open System
+open System.Collections.Generic
+open System.Text.Json.Serialization
+
+/// Module containing JSON serializing extension members for the OuterCollectRemaining type
+[<AutoOpen>]
+module OuterCollectRemainingJsonSerializeExtension =
+    /// Extension methods for JSON parsing
+    type OuterCollectRemaining with
+
+        /// Serialize to a JSON node
+        static member toJsonNode (input : OuterCollectRemaining) : System.Text.Json.Nodes.JsonNode =
+            let node = System.Text.Json.Nodes.JsonObject ()
+
+            do
+                for KeyValue (key, value) in input.Others do
+                    node.Add (key, System.Text.Json.Nodes.JsonValue.Create<int> value)
+
+                node.Add ("remaining", (input.Remaining |> CollectRemaining.toJsonNode))
+
+            node :> _
 
 namespace ConsumePlugin
 
@@ -424,6 +480,8 @@ module JsonRecordTypeWithBothJsonParseExtension =
 
         /// Parse from a JSON node.
         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
+            let arg_21 = ()
+
             let arg_20 =
                 (match node.["timestamp"] with
                  | null ->
@@ -705,6 +763,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
                 IntMeasureNullable = arg_18
                 Enum = arg_19
                 Timestamp = arg_20
+                Unit = arg_21
             }
 namespace ConsumePlugin
 
@@ -842,3 +901,83 @@ module FooJsonParseExtension =
             {
                 Message = arg_0
             }
+namespace ConsumePlugin
+
+/// Module containing JSON parsing extension members for the CollectRemaining type
+[<AutoOpen>]
+module CollectRemainingJsonParseExtension =
+    /// Extension methods for JSON parsing
+    type CollectRemaining with
+
+        /// Parse from a JSON node.
+        static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : CollectRemaining =
+            let arg_1 =
+                let result =
+                    System.Collections.Generic.Dictionary<string, System.Text.Json.Nodes.JsonNode> ()
+
+                let node = node.AsObject ()
+
+                for KeyValue (key, value) in node do
+                    if key = "message" then () else result.Add (key, node.[key])
+
+                result
+
+            let arg_0 =
+                match node.["message"] with
+                | null -> None
+                | v -> HeaderAndValue.jsonParse v |> Some
+
+            {
+                Message = arg_0
+                Rest = arg_1
+            }
+namespace ConsumePlugin
+
+/// Module containing JSON parsing extension members for the OuterCollectRemaining type
+[<AutoOpen>]
+module OuterCollectRemainingJsonParseExtension =
+    /// Extension methods for JSON parsing
+    type OuterCollectRemaining with
+
+        /// Parse from a JSON node.
+        static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : OuterCollectRemaining =
+            let arg_1 =
+                CollectRemaining.jsonParse (
+                    match node.["remaining"] with
+                    | null ->
+                        raise (
+                            System.Collections.Generic.KeyNotFoundException (
+                                sprintf "Required key '%s' not found on JSON object" ("remaining")
+                            )
+                        )
+                    | v -> v
+                )
+
+            let arg_0 =
+                let result = System.Collections.Generic.Dictionary<string, int> ()
+                let node = node.AsObject ()
+
+                for KeyValue (key, value) in node do
+                    if key = "remaining" then
+                        ()
+                    else
+                        result.Add (
+                            key,
+                            (match node.[key] with
+                             | null ->
+                                 raise (
+                                     System.Collections.Generic.KeyNotFoundException (
+                                         sprintf "Required key '%s' not found on JSON object" (key)
+                                     )
+                                 )
+                             | v -> v)
+                                .AsValue()
+                                .GetValue<System.Int32> ()
+                        )
+
+                result
+
+            {
+                Others = arg_0
+                Remaining = arg_1
+            }

ConsumePlugin/SerializationAndDeserialization.fs

@@ -50,6 +50,7 @@ type JsonRecordTypeWithBoth =
         IntMeasureNullable : int<measure> Nullable
         Enum : SomeEnum
         Timestamp : DateTimeOffset
+        Unit : unit
     }
 
 [<WoofWare.Myriad.Plugins.JsonSerialize true>]
@@ -73,3 +74,21 @@ type Foo =
     {
         Message : HeaderAndValue option
     }
+
+[<WoofWare.Myriad.Plugins.JsonSerialize true>]
+[<WoofWare.Myriad.Plugins.JsonParse true>]
+type CollectRemaining =
+    {
+        Message : HeaderAndValue option
+        [<JsonExtensionData>]
+        Rest : Dictionary<string, System.Text.Json.Nodes.JsonNode>
+    }
+
+[<WoofWare.Myriad.Plugins.JsonSerialize true>]
+[<WoofWare.Myriad.Plugins.JsonParse true>]
+type OuterCollectRemaining =
+    {
+        [<JsonExtensionData>]
+        Others : Dictionary<string, int>
+        Remaining : CollectRemaining
+    }

WoofWare.Myriad.Plugins.Attributes/ArgParserAttributes.fs

@@ -19,9 +19,22 @@ type ArgParserAttribute (isExtensionMethod : bool) =
 
 /// Attribute indicating that this field shall accumulate all unmatched args,
 /// as well as any that appear after a bare `--`.
-type PositionalArgsAttribute () =
+///
+/// Set `includeFlagLike = true` to include args that begin `--` in the
+/// positional args.
+/// (By default, `includeFlagLike = false` and we throw when encountering
+/// an argument which looks like a flag but which we don't recognise.)
+/// We will still interpret `--help` as requesting help, unless it comes after
+/// a standalone `--` separator.
+type PositionalArgsAttribute (includeFlagLike : bool) =
     inherit Attribute ()
 
+    /// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor.
+    static member DefaultIncludeFlagLike = false
+
+    /// Shorthand for the "includeFlagLike = false" constructor; see documentation there for details.
+    new () = PositionalArgsAttribute PositionalArgsAttribute.DefaultIncludeFlagLike
+
 /// Attribute indicating that this field shall have a default value derived
 /// from calling an appropriately named static method on the type.
 ///
@@ -61,3 +74,24 @@ type ParseExactAttribute (format : string) =
 /// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.InvariantCulture).
 type InvariantCultureAttribute () =
     inherit Attribute ()
+
+/// Attribute placed on a field of a two-case no-data discriminated union, indicating that this is "basically a bool".
+/// For example: `type DryRun = | [<ArgumentFlag true>] Dry | [<ArgumentFlag false>] Wet`
+/// A record with `{ DryRun : DryRun }` will then be parsed like `{ DryRun : bool }` (so the user supplies `--dry-run`),
+/// but that you get this strongly-typed value directly in the code (so you `match args.DryRun with | DryRun.Dry ...`).
+///
+/// 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

@@ -7,8 +7,12 @@ WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute inherit Syst
 WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute..ctor [constructor]: unit
+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
@@ -36,7 +40,10 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [sta
 WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
 WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute
+WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: bool
 WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.PositionalArgsAttribute.DefaultIncludeFlagLike [static property]: [read-only] bool
+WoofWare.Myriad.Plugins.PositionalArgsAttribute.get_DefaultIncludeFlagLike [static method]: unit -> bool
 WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute
 WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.RestEase inherit obj

WoofWare.Myriad.Plugins.Attributes/Test/WoofWare.Myriad.Plugins.Attributes.Test.fsproj

@@ -1,10 +1,15 @@
 <Project Sdk="Microsoft.NET.Sdk">
 
     <PropertyGroup>
-        <TargetFramework>net8.0</TargetFramework>
+      <TargetFramework>net8.0</TargetFramework>
 
-        <IsPackable>false</IsPackable>
-        <IsTestProject>true</IsTestProject>
+      <IsPackable>false</IsPackable>
+      <IsTestProject>true</IsTestProject>
+      <!--
+        Known high severity vulnerability
+        I have not yet seen a single instance where I care about this warning
+      -->
+      <NoWarn>$(NoWarn),NU1903</NoWarn>
     </PropertyGroup>
 
     <ItemGroup>
@@ -13,7 +18,7 @@
 
     <ItemGroup>
         <PackageReference Include="ApiSurface" Version="4.1.5" />
-        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
+        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
         <PackageReference Include="NUnit" Version="4.2.2"/>
         <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
     </ItemGroup>

WoofWare.Myriad.Plugins.Attributes/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "3.2",
+  "version": "3.5",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],
@@ -12,4 +12,4 @@
     "./",
     ":^Test"
   ]
-}
+}

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

@@ -367,18 +367,19 @@ Required argument '--exact' received no value"""
         let parsed =
             ParentRecordChildPos.parse'
                 getEnvVar
-                [ "--and-another=true" ; "--thing1=9" ; "--thing2=some" ; "--thing2=thing" ]
+                [
+                    "--and-another=true"
+                    "--thing1=9"
+                    "--thing2=https://example.com"
+                    "--thing2=http://example.com"
+                ]
 
-        parsed
-        |> shouldEqual
-            {
-                Child =
-                    {
-                        Thing1 = 9
-                        Thing2 = [ "some" ; "thing" ]
-                    }
-                AndAnother = true
-            }
+        parsed.AndAnother |> shouldEqual true
+        parsed.Child.Thing1 |> shouldEqual 9
+
+        parsed.Child.Thing2
+        |> List.map (fun (x : Uri) -> x.ToString ())
+        |> shouldEqual [ "https://example.com/" ; "http://example.com/" ]
 
     [<Test>]
     let ``Can consume stacked record, child has no positionals, parent has positionals`` () =
@@ -421,3 +422,285 @@ Required argument '--exact' received no value"""
 --thing1  int32
 --thing2  string
 --and-another  bool (positional args) (can be repeated)"""
+
+    [<Test>]
+    let ``Positionals are tagged with Choice`` () =
+        let getEnvVar (_ : string) = failwith "should not call"
+
+        ChoicePositionals.parse' getEnvVar [ "a" ; "b" ; "--" ; "--c" ; "--help" ]
+        |> shouldEqual
+            {
+                Args = [ Choice1Of2 "a" ; Choice1Of2 "b" ; Choice2Of2 "--c" ; Choice2Of2 "--help" ]
+            }
+
+    let boolCases =
+        [
+            "1", true
+            "0", false
+            "true", true
+            "false", false
+            "TRUE", true
+            "FALSE", false
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof (boolCases))>]
+    let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
+        let getEnvVar (s : string) =
+            s |> shouldEqual "CONSUMEPLUGIN_THINGS"
+            envValue
+
+        ContainsBoolEnvVar.parse' getEnvVar []
+        |> shouldEqual
+            {
+                BoolVar = Choice2Of2 boolValue
+            }
+
+    [<Test>]
+    let ``Bools can be treated with arity 0`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsBoolEnvVar.parse' getEnvVar [ "--bool-var" ]
+        |> shouldEqual
+            {
+                BoolVar = Choice1Of2 true
+            }
+
+    [<TestCaseSource(nameof boolCases)>]
+    let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
+        let getEnvVar (s : string) =
+            s |> shouldEqual "CONSUMEPLUGIN_THINGS"
+            envValue
+
+        let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
+
+        ContainsFlagEnvVar.parse' getEnvVar []
+        |> shouldEqual
+            {
+                DryRun = Choice2Of2 boolValue
+            }
+
+    let dryRunData =
+        [
+            [ "--dry-run" ], DryRunMode.Dry
+            [ "--dry-run" ; "true" ], DryRunMode.Dry
+            [ "--dry-run=true" ], DryRunMode.Dry
+            [ "--dry-run" ; "True" ], DryRunMode.Dry
+            [ "--dry-run=True" ], DryRunMode.Dry
+            [ "--dry-run" ; "false" ], DryRunMode.Wet
+            [ "--dry-run=false" ], DryRunMode.Wet
+            [ "--dry-run" ; "False" ], DryRunMode.Wet
+            [ "--dry-run=False" ], DryRunMode.Wet
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof dryRunData)>]
+    let ``Flag DUs can be parsed`` (args : string list, expected : DryRunMode) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagEnvVar.parse' getEnvVar args
+        |> shouldEqual
+            {
+                DryRun = Choice1Of2 expected
+            }
+
+    [<TestCaseSource(nameof dryRunData)>]
+    let ``Flag DUs can be parsed, ArgumentDefaultFunction`` (args : string list, expected : DryRunMode) =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagDefaultValue.parse' getEnvVar args
+        |> shouldEqual
+            {
+                DryRun = Choice1Of2 expected
+            }
+
+    [<Test>]
+    let ``Flag DUs can be given a default value`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        ContainsFlagDefaultValue.parse' getEnvVar []
+        |> shouldEqual
+            {
+                DryRun = Choice2Of2 DryRunMode.Wet
+            }
+
+    [<Test>]
+    let ``Help text for flag DU`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                ContainsFlagDefaultValue.parse' getEnvVar [ "--help" ]
+                |> ignore<ContainsFlagDefaultValue>
+            )
+
+        exc.Message
+        |> shouldEqual
+            """Help text requested.
+--dry-run  bool (default value: false)"""
+
+    [<Test>]
+    let ``Help text for flag DU, non default`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () -> WithFlagDu.parse' getEnvVar [ "--help" ] |> ignore<WithFlagDu>)
+
+        exc.Message
+        |> 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"""
+
+    [<Test>]
+    let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
+        |> shouldEqual
+            {
+                A = "foo"
+                GrabEverything = [ "--b=false" ; "--c" ; "hi" ; "--help" ]
+            }
+
+        // Users might consider this eccentric!
+        // But we're only a simple arg parser; we don't look around to see whether this is "almost"
+        // a valid parse.
+        FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
+        |> shouldEqual
+            {
+                A = "--b=false"
+                GrabEverything = [ "--c" ; "hi" ; "--help" ]
+            }
+
+    [<Test>]
+    let ``Can collect non-help args into positional args with Choice`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        FlagsIntoPositionalArgsChoice.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
+        |> shouldEqual
+            {
+                A = "foo"
+                GrabEverything =
+                    [
+                        Choice1Of2 "--b=false"
+                        Choice1Of2 "--c"
+                        Choice1Of2 "hi"
+                        Choice2Of2 "--help"
+                    ]
+            }
+
+    [<Test>]
+    let ``Can collect non-help args into positional args, and we parse on the way`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        FlagsIntoPositionalArgsInt.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
+        |> shouldEqual
+            {
+                A = "foo"
+                GrabEverything = [ 3 ; 5 ; 98 ]
+            }
+
+    [<Test>]
+    let ``Can collect non-help args into positional args with Choice, and we parse on the way`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        FlagsIntoPositionalArgsIntChoice.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
+        |> shouldEqual
+            {
+                A = "foo"
+                GrabEverything = [ Choice1Of2 3 ; Choice1Of2 5 ; Choice2Of2 98 ]
+            }
+
+    [<Test>]
+    let ``Can refuse to collect non-help args with PositionalArgs false`` () =
+        let getEnvVar (_ : string) = failwith "do not call"
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                FlagsIntoPositionalArgs'.parse'
+                    getEnvVar
+                    [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
+                |> ignore<FlagsIntoPositionalArgs'>
+            )
+
+        exc.Message
+        |> shouldEqual """Unable to process argument --b=false as key --b and value false"""
+
+        let exc =
+            Assert.Throws<exn> (fun () ->
+                FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
+                |> ignore<FlagsIntoPositionalArgs'>
+            )
+
+        // Again perhaps eccentric!
+        // Again, we don't try to detect that the user has missed out the desired argument to `--a`.
+        exc.Message
+        |> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""

WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs

@@ -117,6 +117,7 @@ module TestJsonSerde =
                     IntMeasureNullable = intMeasureNullable
                     Enum = enum<SomeEnum> someEnum
                     Timestamp = timestamp
+                    Unit = ()
                 }
         }
 
@@ -168,6 +169,7 @@ module TestJsonSerde =
                 IntMeasureNullable = Nullable -883<measure>
                 Enum = enum<SomeEnum> 1
                 Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0)
+                Unit = ()
             }
 
         let expected =
@@ -198,7 +200,8 @@ module TestJsonSerde =
     "intMeasureOption": 981,
     "intMeasureNullable": -883,
     "enum": 1,
-    "timestamp": "2024-07-01T17:54:00.0000000\u002B01:00"
+    "timestamp": "2024-07-01T17:54:00.0000000\u002B01:00",
+    "unit": {}
 }
 """
             |> fun s -> s.ToCharArray ()
@@ -306,3 +309,166 @@ module TestJsonSerde =
 
         for i in counts do
             i |> shouldBeGreaterThan 0
+
+    let dict<'a, 'b when 'a : equality> (xs : ('a * 'b) seq) : Dictionary<'a, 'b> =
+        let result = Dictionary ()
+
+        for k, v in xs do
+            result.Add (k, v)
+
+        result
+
+    let inline makeJsonArr< ^t, ^u when ^u : (static member op_Implicit : ^t -> JsonNode) and ^u :> JsonNode>
+        (arr : ^t seq)
+        : JsonNode
+        =
+        let result = JsonArray ()
+
+        for a in arr do
+            result.Add a
+
+        result :> JsonNode
+
+    let normalise (d : Dictionary<'a, 'b>) : ('a * 'b) list =
+        d |> Seq.map (fun (KeyValue (a, b)) -> a, b) |> Seq.toList |> List.sortBy fst
+
+    [<Test>]
+    let ``Can collect extension data`` () =
+        let str =
+            """{
+    "message": { "header": "hi", "value": "bye" },
+    "something": 3,
+    "arr": ["egg", "toast"],
+    "str": "whatnot"
+}"""
+            |> JsonNode.Parse
+
+        let expected =
+            {
+                Rest =
+                    [
+                        "something", JsonNode.op_Implicit 3
+                        "arr", makeJsonArr [| "egg" ; "toast" |]
+                        "str", JsonNode.op_Implicit "whatnot"
+                    ]
+                    |> dict
+                Message =
+                    Some
+                        {
+                            Header = "hi"
+                            Value = "bye"
+                        }
+            }
+
+        let actual = CollectRemaining.jsonParse str
+
+        actual.Message |> shouldEqual expected.Message
+
+        normalise actual.Rest
+        |> List.map (fun (k, v) -> k, v.ToJsonString ())
+        |> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
+
+    [<Test>]
+    let ``Can write out extension data`` () =
+        let expected =
+            """{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}"""
+
+        let toWrite =
+            {
+                Rest =
+                    [
+                        "something", JsonNode.op_Implicit 3
+                        "arr", makeJsonArr [| "egg" ; "toast" |]
+                        "str", JsonNode.op_Implicit "whatnot"
+                    ]
+                    |> dict
+                Message =
+                    Some
+                        {
+                            Header = "hi"
+                            Value = "bye"
+                        }
+            }
+
+        let actual = CollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
+
+        actual |> shouldEqual expected
+
+    [<Test>]
+    let ``Can collect extension data, nested`` () =
+        let str =
+            """{
+  "thing": 99,
+  "baz": -123,
+  "remaining": {
+    "message": { "header": "hi", "value": "bye" },
+    "something": 3,
+    "arr": ["egg", "toast"],
+    "str": "whatnot"
+  }
+}"""
+            |> JsonNode.Parse
+
+        let expected : OuterCollectRemaining =
+            {
+                Remaining =
+                    {
+                        Message =
+                            Some
+                                {
+                                    Header = "hi"
+                                    Value = "bye"
+                                }
+                        Rest =
+                            [
+                                "something", JsonNode.op_Implicit 3
+                                "arr", makeJsonArr [| "egg" ; "toast" |]
+                                "str", JsonNode.op_Implicit "whatnot"
+                            ]
+                            |> dict
+                    }
+                Others = [ "thing", 99 ; "baz", -123 ] |> dict
+            }
+
+        let actual = OuterCollectRemaining.jsonParse str
+
+        normalise actual.Others |> shouldEqual (normalise expected.Others)
+
+        let actual = actual.Remaining
+        let expected = expected.Remaining
+
+        actual.Message |> shouldEqual expected.Message
+
+        normalise actual.Rest
+        |> List.map (fun (k, v) -> k, v.ToJsonString ())
+        |> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
+
+    [<Test>]
+    let ``Can write out extension data, nested`` () =
+        let expected =
+            """{"thing":99,"baz":-123,"remaining":{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}}"""
+
+        let toWrite : OuterCollectRemaining =
+            {
+                Others = [ "thing", 99 ; "baz", -123 ] |> dict
+                Remaining =
+                    {
+                        Rest =
+                            [
+                                "something", JsonNode.op_Implicit 3
+                                "arr", makeJsonArr [| "egg" ; "toast" |]
+                                "str", JsonNode.op_Implicit "whatnot"
+                            ]
+                            |> dict
+                        Message =
+                            Some
+                                {
+                                    Header = "hi"
+                                    Value = "bye"
+                                }
+                    }
+            }
+
+        let actual = OuterCollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
+
+        actual |> shouldEqual expected

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

@@ -4,6 +4,11 @@
     <TargetFramework>net8.0</TargetFramework>
     <IsPackable>false</IsPackable>
     <IsTestProject>true</IsTestProject>
+    <!--
+      Known high severity vulnerability
+      I have not yet seen a single instance where I care about this warning
+    -->
+    <NoWarn>$(NoWarn),NU1903</NoWarn>
   </PropertyGroup>
 
   <ItemGroup>
@@ -37,7 +42,7 @@
     <PackageReference Include="ApiSurface" Version="4.1.5"/>
     <PackageReference Include="FsCheck" Version="2.16.6"/>
     <PackageReference Include="FsUnit" Version="6.0.0"/>
-    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
+    <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
     <PackageReference Include="NUnit" Version="4.2.2"/>
     <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
   </ItemGroup>

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -67,41 +67,109 @@ type internal RecordType =
         Members : SynMemberDefns option
         XmlDoc : PreXmlDoc option
         Generics : SynTyparDecls option
-        Accessibility : SynAccess option
+        TypeAccessibility : SynAccess option
+        ImplAccessibility : SynAccess option
         Attributes : SynAttribute list
     }
 
     /// Parse from the AST.
-    static member OfRecord (record : SynTypeDefn) : RecordType =
-        let sci, sdr, smd, smdo =
-            match record with
-            | SynTypeDefn.SynTypeDefn (sci, sdr, smd, smdo, _, _) -> sci, sdr, smd, smdo
-
-        let synAccessOption, recordFields =
-            match sdr with
-            | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (sa, fields, _), _) -> sa, fields
-            | _ -> failwith $"expected a record; got: %+A{record}"
-
+    static member OfRecord
+        (sci : SynComponentInfo)
+        (smd : SynMemberDefns)
+        (access : SynAccess option)
+        (recordFields : SynField list)
+        : RecordType
+        =
         match sci with
-        | SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access, _) ->
-            if access <> synAccessOption then
-                failwith
-                    $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{synAccessOption}"
-
-            match smdo with
-            | Some v -> failwith $"TODO what's happened, got a synMemberDefn of %O{v}"
-            | None -> ()
-
+        | 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 = synAccessOption
+                ImplAccessibility = implAccess
+                TypeAccessibility = access
                 Attributes = attrs |> List.collect (fun l -> l.Attributes)
             }
 
+/// Methods for manipulating UnionCase.
+[<RequireQualifiedAccess>]
+module UnionCase =
+    /// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything
+    /// we care about from the AST representation.
+    let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> =
+        match case with
+        | SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) ->
+
+        let ident =
+            match ident with
+            | SynIdent.SynIdent (ident, _) -> ident
+
+        let fields =
+            match caseType with
+            | SynUnionCaseKind.Fields cases -> cases
+            | SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union"
+
+        {
+            Name = ident
+            XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc
+            Access = access
+            Attributes = attributes |> List.collect (fun t -> t.Attributes)
+            Fields = fields |> List.map SynField.extract
+        }
+
+    /// Functorial `map`.
+    let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
+        {
+            Attributes = unionCase.Attributes
+            Name = unionCase.Name
+            Access = unionCase.Access
+            XmlDoc = unionCase.XmlDoc
+            Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
+        }
+
+/// Everything you need to know about a discriminated union definition.
+type internal UnionType =
+    {
+        /// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`.
+        Name : Ident
+        /// Any additional members which are not union cases.
+        Members : SynMemberDefns option
+        /// Any docstring associated with the DU itself (not its cases).
+        XmlDoc : PreXmlDoc option
+        /// Generic type parameters this DU takes: `type Foo<'a> = | ...`.
+        Generics : SynTyparDecls option
+        /// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
+        Attributes : SynAttribute list
+        /// Accessibility modifier of the DU: `type private Foo = ...`
+        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
+    }
+
+    static member OfUnion
+        (sci : SynComponentInfo)
+        (smd : SynMemberDefns)
+        (access : SynAccess option)
+        (cases : SynUnionCase list)
+        : UnionType
+        =
+        match sci with
+        | 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)
+                TypeAccessibility = access
+                ImplAccessibility = implAccess
+                Cases = cases |> List.map UnionCase.ofSynUnionCase
+            }
+
 /// Anything that is part of an ADT.
 /// A record is a product of stuff; this type represents one of those stuffs.
 type internal AdtNode =
@@ -144,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/CataGenerator.fs

@@ -564,11 +564,12 @@ module internal CataGenerator =
                     let domain =
                         field.FieldName
                         |> Option.map Ident.lowerFirstLetter
-                        |> SynType.signatureParamOfType place
+                        |> SynType.signatureParamOfType [] place false
 
                     acc |> SynType.funFromDomain domain
                 )
                 |> SynMemberDefn.abstractMember
+                    []
                     case.CataMethodIdent
                     None
                     arity

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 = []
             }
 
@@ -227,14 +228,11 @@ module internal InterfaceMockGenerator =
             x.Type
 
     let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
-        match tuple.Args |> List.rev |> List.map buildType with
-        | [] -> failwith "no-arg functions not supported yet"
-        | [ x ] -> x
-        | last :: rest ->
-            ([ SynTupleTypeSegment.Type last ], rest)
-            ||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
-            |> fun segs -> SynType.Tuple (false, segs, range0)
-        |> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
+        tuple.Args
+        |> List.map buildType
+        |> SynType.tupleNoParen
+        |> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet")
+        |> if tuple.HasParen then SynType.paren else id
 
     let constructMember (mem : MemberInfo) : SynField =
         let inputType = mem.Args |> List.map constructMemberSinglePlace

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -59,7 +59,7 @@ module internal JsonParseGenerator =
         | None -> node
         | Some propertyName -> assertNotNull propertyName node
         |> SynExpr.callMethod "AsValue"
-        |> SynExpr.callGenericMethod "GetValue" typeName
+        |> SynExpr.callGenericMethod (SynLongIdent.createS "GetValue") [ SynType.createLongIdent typeName ]
 
     /// {node}.AsObject()
     /// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
@@ -279,6 +279,8 @@ module internal JsonParseGenerator =
         | Measure (_measure, primType) ->
             parseNumberType options propertyName node primType
             |> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
+        | JsonNode -> node
+        | Unit -> SynExpr.CreateConst ()
         | _ ->
             // Let's just hope that we've also got our own type annotation!
             let typeName =
@@ -375,9 +377,9 @@ module internal JsonParseGenerator =
         )
 
     let createRecordMaker (spec : JsonParseOutputSpec) (fields : SynFieldData<Ident> list) =
-        let assignments =
+        let propertyFields =
             fields
-            |> List.mapi (fun i fieldData ->
+            |> List.map (fun fieldData ->
                 let propertyNameAttr =
                     fieldData.Attrs
                     |> List.tryFind (fun attr ->
@@ -385,7 +387,12 @@ module internal JsonParseGenerator =
                             .EndsWith ("JsonPropertyName", StringComparison.Ordinal)
                     )
 
-                let options = getParseOptions fieldData.Attrs
+                let extensionDataAttr =
+                    fieldData.Attrs
+                    |> List.tryFind (fun attr ->
+                        (SynLongIdent.toString attr.TypeName)
+                            .EndsWith ("JsonExtensionData", StringComparison.Ordinal)
+                    )
 
                 let propertyName =
                     match propertyNameAttr with
@@ -401,8 +408,77 @@ module internal JsonParseGenerator =
                         sb.ToString () |> SynExpr.CreateConst
                     | Some name -> name.ArgExpr
 
+                propertyName, extensionDataAttr
+            )
+
+        let namedPropertyFields =
+            propertyFields
+            |> List.choose (fun (name, extension) ->
+                match extension with
+                | Some _ -> None
+                | None -> Some name
+            )
+
+        let isNamedPropertyField =
+            match namedPropertyFields with
+            | [] -> SynExpr.CreateConst false
+            | _ ->
+                namedPropertyFields
+                |> List.map (fun fieldName -> SynExpr.equals (SynExpr.createIdent "key") fieldName)
+                |> List.reduce SynExpr.booleanOr
+
+        let assignments =
+            List.zip fields propertyFields
+            |> List.mapi (fun i (fieldData, (propertyName, extensionDataAttr)) ->
+                let options = getParseOptions fieldData.Attrs
+
+                let accIdent = Ident.create $"arg_%i{i}"
+
+                match extensionDataAttr with
+                | Some _ ->
+                    // Can't go through the usual parse logic here, because that will try and identify the node that's
+                    // been labelled. The whole point of JsonExtensionData is that there is no such node!
+                    let valType =
+                        match fieldData.Type with
+                        | DictionaryType (String, v) -> v
+                        | _ -> failwith "Expected JsonExtensionData to be Dictionary<string, _>"
+
+                    SynExpr.ifThenElse
+                        isNamedPropertyField
+                        (SynExpr.callMethodArg
+                            "Add"
+                            (SynExpr.tuple
+                                [
+                                    SynExpr.createIdent "key"
+                                    createParseRhs options (SynExpr.createIdent "key") valType
+                                ])
+                            (SynExpr.createIdent "result"))
+                        (SynExpr.CreateConst ())
+                    |> SynExpr.createForEach
+                        (SynPat.nameWithArgs "KeyValue" [ SynPat.named "key" ; SynPat.named "value" ])
+                        (SynExpr.createIdent "node")
+                    |> fun forEach -> [ forEach ; SynExpr.createIdent "result" ]
+                    |> SynExpr.sequential
+                    |> SynExpr.createLet
+                        [
+                            SynBinding.basic
+                                [ Ident.create "result" ]
+                                []
+                                (SynExpr.typeApp
+                                    [ SynType.string ; valType ]
+                                    (SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
+                                 |> SynExpr.applyTo (SynExpr.CreateConst ()))
+
+                            SynBinding.basic
+                                [ Ident.create "node" ]
+                                []
+                                (SynExpr.createIdent "node" |> SynExpr.callMethod "AsObject")
+                        ]
+                    |> SynBinding.basic [ accIdent ] []
+                | None ->
+
                 createParseRhs options propertyName fieldData.Type
-                |> SynBinding.basic [ Ident.create $"arg_%i{i}" ] []
+                |> SynBinding.basic [ accIdent ] []
             )
 
         let finalConstruction =
@@ -416,11 +492,11 @@ module internal JsonParseGenerator =
     let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
         fields
         |> List.map (fun case ->
-            let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
+            let propertyName = JsonSerializeGenerator.getPropertyName case.Name case.Attributes
 
             let body =
                 if case.Fields.IsEmpty then
-                    SynExpr.createLongIdent' (typeName @ [ case.Ident ])
+                    SynExpr.createLongIdent' (typeName @ [ case.Name ])
                 else
                     case.Fields
                     |> List.map (fun field ->
@@ -429,7 +505,7 @@ module internal JsonParseGenerator =
                         createParseRhs options propertyName field.Type
                     )
                     |> SynExpr.tuple
-                    |> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
+                    |> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Name ]))
                     |> SynExpr.createLet
                         [
                             SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
@@ -483,9 +559,7 @@ module internal JsonParseGenerator =
                 |> SynExpr.index property
                 |> assertNotNull property
                 |> SynExpr.pipeThroughFunction (
-                    SynExpr.createLambda
-                        "v"
-                        (SynExpr.callGenericMethod "GetValue" [ Ident.create "string" ] (SynExpr.createIdent "v"))
+                    SynExpr.createLambda "v" (SynExpr.callGenericMethod' "GetValue" "string" (SynExpr.createIdent "v"))
                 )
                 |> SynBinding.basic [ Ident.create "ty" ] []
             ]
@@ -600,7 +674,7 @@ module internal JsonParseGenerator =
                     | Some i -> i
 
                 cases
-                |> List.map SynUnionCase.extract
+                |> List.map UnionCase.ofSynUnionCase
                 |> List.map (UnionCase.mapIdentFields optionGet)
                 |> createUnionMaker spec ident
             | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -146,6 +146,13 @@ module internal JsonSerializeGenerator =
                 ]
             |> SynExpr.createLambda "field"
             |> fun e -> e, false
+        | JsonNode -> SynExpr.createIdent "id", true
+        | Unit ->
+            SynExpr.createLambda
+                "value"
+                (SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
+                 |> SynExpr.applyTo (SynExpr.CreateConst ())),
+            false
         | _ ->
             // {type}.toJsonNode
             let typeName =
@@ -187,6 +194,14 @@ module internal JsonSerializeGenerator =
             sb.ToString () |> SynExpr.CreateConst
         | Some name -> name.ArgExpr
 
+    let getIsJsonExtension (attrs : SynAttribute list) : bool =
+        attrs
+        |> List.tryFind (fun attr ->
+            (SynLongIdent.toString attr.TypeName)
+                .EndsWith ("JsonExtensionData", StringComparison.Ordinal)
+        )
+        |> Option.isSome
+
     /// `populateNode` will be inserted before we return the `node` variable.
     ///
     /// That is, we give you access to a `JsonObject` called `node`,
@@ -256,18 +271,42 @@ module internal JsonSerializeGenerator =
         fields
         |> List.map (fun fieldData ->
             let propertyName = getPropertyName fieldData.Ident fieldData.Attrs
-            createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type
+            let isJsonExtension = getIsJsonExtension fieldData.Attrs
+
+            if isJsonExtension then
+                let valType =
+                    match fieldData.Type with
+                    | DictionaryType (String, v) -> v
+                    | _ -> failwith "Expected JsonExtensionData to be a Dictionary<string, something>"
+
+                let serialise = fst (serializeNode valType)
+
+                SynExpr.createIdent "node"
+                |> SynExpr.callMethodArg
+                    "Add"
+                    (SynExpr.tuple
+                        [
+                            SynExpr.createIdent "key"
+                            SynExpr.applyFunction serialise (SynExpr.createIdent "value")
+                        ])
+                |> SynExpr.createForEach
+                    (SynPat.identWithArgs
+                        [ Ident.create "KeyValue" ]
+                        (SynArgPats.create [ SynPat.named "key" ; SynPat.named "value" ]))
+                    (SynExpr.createLongIdent' [ Ident.create "input" ; fieldData.Ident ])
+            else
+                createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type
         )
         |> SynExpr.sequential
         |> fun expr -> SynExpr.Do (expr, range0)
 
     let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
         let inputArg = Ident.create "input"
-        let fields = cases |> List.map SynUnionCase.extract
+        let fields = cases |> List.map UnionCase.ofSynUnionCase
 
         fields
         |> List.map (fun unionCase ->
-            let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
+            let propertyName = getPropertyName unionCase.Name unionCase.Attributes
 
             let caseNames = unionCase.Fields |> List.mapi (fun i _ -> $"arg%i{i}")
 
@@ -275,7 +314,7 @@ module internal JsonSerializeGenerator =
 
             let pattern =
                 SynPat.LongIdent (
-                    SynLongIdent.create (typeName @ [ unionCase.Ident ]),
+                    SynLongIdent.create (typeName @ [ unionCase.Name ]),
                     None,
                     None,
                     argPats,

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/SurfaceBaseline.txt

@@ -11,4 +11,27 @@ WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
 WoofWare.Myriad.Plugins.JsonSerializeGenerator..ctor [constructor]: unit
 WoofWare.Myriad.Plugins.RemoveOptionsGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
-WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj
+WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType)
+WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident
+WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType
+WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident
+WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType
+WoofWare.Myriad.Plugins.UnionCase inherit obj
+WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase
+WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase
+WoofWare.Myriad.Plugins.UnionCase`1 inherit obj
+WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list)
+WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option
+WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option
+WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list
+WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident
+WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option
+WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident
+WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option

WoofWare.Myriad.Plugins/SynExpr/Ident.fs

@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
 
 open System
 open System.Text
+open System.Text.RegularExpressions
 open Fantomas.FCS.Syntax
 open Fantomas.FCS.Text.Range
 
@@ -9,6 +10,54 @@ open Fantomas.FCS.Text.Range
 module internal Ident =
     let inline create (s : string) = Ident (s, range0)
 
+    /// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical
+    /// apart from the ranges?
+    /// Awful hack: here is a function that does this sort of thing.
+    let createSanitisedParamName (s : string) =
+        match s with
+        | "type" -> create "type'"
+        | "private" -> create "private'"
+        | _ ->
+
+        let result = StringBuilder ()
+
+        for i = 0 to s.Length - 1 do
+            if Char.IsLetter s.[i] then
+                result.Append s.[i] |> ignore<StringBuilder>
+            elif Char.IsNumber s.[i] then
+                if result.Length > 0 then
+                    result.Append s.[i] |> ignore<StringBuilder>
+            elif s.[i] = '_' || s.[i] = '-' then
+                result.Append '_' |> ignore<StringBuilder>
+            else
+                failwith $"could not convert to ident: %s{s}"
+
+        create (result.ToString ())
+
+    let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$"
+
+    let createSanitisedTypeName (s : string) =
+        let result = StringBuilder ()
+        let mutable capitalize = true
+
+        for i = 0 to s.Length - 1 do
+            if Char.IsLetter s.[i] then
+                if capitalize then
+                    result.Append (Char.ToUpperInvariant s.[i]) |> ignore<StringBuilder>
+                    capitalize <- false
+                else
+                    result.Append s.[i] |> ignore<StringBuilder>
+            elif Char.IsNumber s.[i] then
+                if result.Length > 0 then
+                    result.Append s.[i] |> ignore<StringBuilder>
+            elif s.[i] = '_' then
+                capitalize <- true
+
+        if result.Length = 0 then
+            failwith $"String %s{s} was not suitable as a type identifier"
+
+        Ident (result.ToString (), range0)
+
     let lowerFirstLetter (x : Ident) : Ident =
         let result = StringBuilder x.idText.Length
         result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore

WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs

@@ -6,7 +6,12 @@ open Fantomas.FCS.Text.Range
 [<RequireQualifiedAccess>]
 module internal PreXmlDoc =
     let create (s : string) : PreXmlDoc =
-        PreXmlDoc.Create ([| " " + s |], range0)
+        let s = s.Split "\n"
+
+        for i = 0 to s.Length - 1 do
+            s.[i] <- " " + s.[i]
+
+        PreXmlDoc.Create (s, range0)
 
     let create' (s : string seq) : PreXmlDoc =
         PreXmlDoc.Create (Array.ofSeq s, range0)

WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs

@@ -9,12 +9,12 @@ module internal SynArgPats =
         match caseNames.Length with
         | 0 -> SynArgPats.Pats []
         | 1 ->
-            SynPat.Named (SynIdent.SynIdent (Ident.create caseNames.[0], None), false, None, range0)
+            SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0)
             |> List.singleton
             |> SynArgPats.Pats
         | len ->
             caseNames
-            |> List.map (fun name -> SynPat.Named (SynIdent.SynIdent (Ident.create name, None), false, None, range0))
+            |> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0))
             |> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0)
             |> fun t -> SynPat.Paren (t, range0)
             |> List.singleton

WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs

@@ -5,32 +5,23 @@ open Fantomas.FCS.Text.Range
 
 [<RequireQualifiedAccess>]
 module internal SynAttribute =
-    let internal compilationRepresentation : SynAttribute =
+    let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute =
         {
-            TypeName = SynLongIdent.createS "CompilationRepresentation"
-            ArgExpr =
-                [ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
-                |> SynExpr.createLongIdent
-                |> SynExpr.paren
+            TypeName = typeName
+            ArgExpr = arg
             Target = None
             AppliesToGetterAndSetter = false
             Range = range0
         }
 
+    let internal compilationRepresentation : SynAttribute =
+        [ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
+        |> SynExpr.createLongIdent
+        |> SynExpr.paren
+        |> create (SynLongIdent.createS "CompilationRepresentation")
+
     let internal requireQualifiedAccess : SynAttribute =
-        {
-            TypeName = SynLongIdent.createS "RequireQualifiedAccess"
-            ArgExpr = SynExpr.CreateConst ()
-            Target = None
-            AppliesToGetterAndSetter = false
-            Range = range0
-        }
+        create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ())
 
     let internal autoOpen : SynAttribute =
-        {
-            TypeName = SynLongIdent.createS "AutoOpen"
-            ArgExpr = SynExpr.CreateConst ()
-            Target = None
-            AppliesToGetterAndSetter = false
-            Range = range0
-        }
+        create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ())

WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs

@@ -80,6 +80,16 @@ module internal SynExpr =
     let equals (a : SynExpr) (b : SynExpr) =
         SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b
 
+    /// {a} && {b}
+    let booleanAnd (a : SynExpr) (b : SynExpr) =
+        SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a)
+        |> applyTo b
+
+    /// {a} || {b}
+    let booleanOr (a : SynExpr) (b : SynExpr) =
+        SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanOr, a)
+        |> applyTo b
+
     /// {a} + {b}
     let plus (a : SynExpr) (b : SynExpr) =
         SynExpr.CreateAppInfix (
@@ -131,16 +141,15 @@ module internal SynExpr =
     let typeApp (types : SynType list) (operand : SynExpr) =
         SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0)
 
-    let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
-        SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0)
-        |> typeApp [ SynType.LongIdent (SynLongIdent.create ty) ]
+    /// {obj}.{meth}<types,...>()
+    let callGenericMethod (meth : SynLongIdent) (types : SynType list) (obj : SynExpr) : SynExpr =
+        SynExpr.DotGet (obj, range0, meth, range0)
+        |> typeApp types
         |> applyTo (SynExpr.CreateConst ())
 
     /// {obj}.{meth}<ty>()
     let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
-        SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0)
-        |> typeApp [ SynType.createLongIdent' [ ty ] ]
-        |> applyTo (SynExpr.CreateConst ())
+        callGenericMethod (SynLongIdent.createS meth) [ SynType.createLongIdent' [ ty ] ] obj
 
     let inline index (property : SynExpr) (obj : SynExpr) : SynExpr =
         SynExpr.DotIndexedGet (obj, property, range0, range0)
@@ -232,6 +241,8 @@ module internal SynExpr =
     let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
         SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty)
 
+    let inline createDo (body : SynExpr) : SynExpr = SynExpr.Do (body, range0)
+
     let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr =
         SynExpr.Match (
             DebugPointAtBinding.Yes range0,

WoofWare.Myriad.Plugins/SynExpr/SynField.fs

@@ -5,10 +5,17 @@ open Fantomas.FCS.Syntax
 open Fantomas.FCS.SyntaxTrivia
 open Fantomas.FCS.Xml
 
-type internal SynFieldData<'Ident> =
+/// The data needed to reconstitute a single piece of data within a union field, or a single record field.
+/// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int`
+/// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified.
+type SynFieldData<'Ident> =
     {
+        /// Attributes on this field. I think you can only get these if this is a *record* field.
         Attrs : SynAttribute list
+        /// The identifier of this field (see docstring for SynFieldData).
         Ident : 'Ident
+        /// The type of the data contained in this field. For example, `type Foo = { Blah : int }`
+        /// has this being `int`.
         Type : SynType
     }
 

WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs

@@ -0,0 +1,10 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.Syntax
+
+[<RequireQualifiedAccess>]
+module internal SynIdent =
+    let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None)
+
+    let inline createS (i : string) : SynIdent =
+        SynIdent.SynIdent (Ident.create i, None)

WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs

@@ -33,6 +33,12 @@ module internal SynLongIdent =
     let eq =
         SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
 
+    let booleanAnd =
+        SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
+
+    let booleanOr =
+        SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanOr" ], [], [ Some (IdentTrivia.OriginalNotation "||") ])
+
     let pipe =
         SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
 

WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs

@@ -17,8 +17,8 @@ module internal SynMemberDefn =
             SynMemberFlags.MemberKind = SynMemberKind.Member
         }
 
-
     let abstractMember
+        (attrs : SynAttribute list)
         (ident : SynIdent)
         (typars : SynTyparDecls option)
         (arity : SynValInfo)
@@ -28,7 +28,13 @@ module internal SynMemberDefn =
         =
         let slot =
             SynValSig.SynValSig (
-                [],
+                attrs
+                |> List.map (fun attr ->
+                    {
+                        Attributes = [ attr ]
+                        Range = range0
+                    }
+                ),
                 ident,
                 SynValTyparDecls.SynValTyparDecls (typars, true),
                 returnType,

WoofWare.Myriad.Plugins/SynExpr/SynType.fs

@@ -181,6 +181,29 @@ module internal SynTypePatterns =
                        _) -> Some (ident, outer)
         | _ -> None
 
+    let (|JsonNode|_|) (fieldType : SynType) : unit option =
+        match fieldType with
+        | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
+            match ident |> List.map (fun i -> i.idText) with
+            | [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
+            | [ "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
+            | [ "Json" ; "Nodes" ; "JsonNode" ]
+            | [ "Nodes" ; "JsonNode" ]
+            | [ "JsonNode" ] -> Some ()
+            | _ -> None
+        | _ -> None
+
+    let (|Unit|_|) (fieldType : SynType) : unit option =
+        match fieldType with
+        | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
+            match ident |> List.map (fun i -> i.idText.ToLowerInvariant ()) with
+            | [ "microsoft" ; "fsharp" ; "core" ; "unit" ]
+            | [ "fsharp" ; "core" ; "unit" ]
+            | [ "core" ; "unit" ]
+            | [ "unit" ] -> Some ()
+            | _ -> None
+        | _ -> None
+
     let (|DateOnly|_|) (fieldType : SynType) =
         match fieldType with
         | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
@@ -267,6 +290,8 @@ module internal SynType =
         | SynType.Paren (ty, _) -> stripOptionalParen ty
         | ty -> ty
 
+    let inline paren (ty : SynType) : SynType = SynType.Paren (ty, range0)
+
     let inline createLongIdent (ident : LongIdent) : SynType =
         SynType.LongIdent (SynLongIdent.create ident)
 
@@ -283,6 +308,17 @@ module internal SynType =
 
     let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
 
+    /// Returns None if the input list was empty.
+    let inline tupleNoParen (ty : SynType list) : SynType option =
+        match List.rev ty with
+        | [] -> None
+        | [ t ] -> Some t
+        | t :: rest ->
+            ([ SynTupleTypeSegment.Type t ], rest)
+            ||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
+            |> fun segs -> SynType.Tuple (false, segs, range0)
+            |> Some
+
     let inline appPostfix (name : string) (arg : SynType) : SynType =
         SynType.App (named name, None, [ arg ], [], None, true, range0)
 
@@ -299,16 +335,54 @@ module internal SynType =
             }
         )
 
-    let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType =
-        SynType.SignatureParameter ([], false, name, ty, range0)
+    let inline signatureParamOfType
+        (attrs : SynAttribute list)
+        (ty : SynType)
+        (optional : bool)
+        (name : Ident option)
+        : SynType
+        =
+        SynType.SignatureParameter (
+            attrs
+            |> List.map (fun attr ->
+                {
+                    Attributes = [ attr ]
+                    Range = range0
+                }
+            ),
+            optional,
+            name,
+            ty,
+            range0
+        )
 
     let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
 
     let unit : SynType = named "unit"
+    let obj : SynType = named "obj"
+    let bool : SynType = named "bool"
     let int : SynType = named "int"
+    let array (elt : SynType) : SynType = SynType.Array (1, elt, range0)
+
+    let list (elt : SynType) : SynType =
+        SynType.App (named "list", None, [ elt ], [], None, true, range0)
+
+    let option (elt : SynType) : SynType =
+        SynType.App (named "option", None, [ elt ], [], None, true, range0)
 
     let anon : SynType = SynType.Anon range0
 
+    let task (elt : SynType) : SynType =
+        SynType.App (
+            createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "Task" ],
+            None,
+            [ elt ],
+            [],
+            None,
+            true,
+            range0
+        )
+
     let string : SynType = named "string"
 
     /// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.
@@ -363,6 +437,7 @@ module internal SynType =
         | DateTimeOffset -> "DateTimeOffset"
         | DateOnly -> "DateOnly"
         | TimeSpan -> "TimeSpan"
+        | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident |> List.map _.idText |> String.concat "."
         | ty -> failwithf "could not compute human-readable string for type: %O" ty
 
     /// Guess whether the types are equal. We err on the side of saying "no, they're different".
@@ -454,4 +529,11 @@ module internal SynType =
             match ty2 with
             | DateOnly -> true
             | _ -> false
-        | _ -> false
+        | _ ->
+
+        match ty1, ty2 with
+        | SynType.LongIdent (SynLongIdent (ident1, _, _)), SynType.LongIdent (SynLongIdent (ident2, _, _)) ->
+            let ident1 = ident1 |> List.map _.idText
+            let ident2 = ident2 |> List.map _.idText
+            ident1 = ident2
+        | _, _ -> false

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

WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs

@@ -5,44 +5,24 @@ open Fantomas.FCS.Text.Range
 open Fantomas.FCS.Xml
 open Fantomas.FCS.SyntaxTrivia
 
-type internal UnionCase<'Ident> =
+/// Represents everything you need to know about a union case.
+/// This is generic on whether each field of this case must be named.
+type UnionCase<'ident> =
     {
-        Fields : SynFieldData<'Ident> list
-        Attrs : SynAttribute list
-        Ident : Ident
+        /// The name of the case: e.g. `| Foo of blah` has this being `Foo`.
+        Name : Ident
+        /// Any docstring associated with this case.
+        XmlDoc : PreXmlDoc option
+        /// Any accessibility modifier: e.g. `type Foo = private | Blah`.
+        Access : SynAccess option
+        /// Attributes on the case: for example, `| [<Attr>] Foo of blah`.
+        Attributes : SynAttribute list
+        /// The data contained within the case: for example, `[blah]` in `| Foo of blah`.
+        Fields : SynFieldData<'ident> list
     }
 
-[<RequireQualifiedAccess>]
-module internal UnionCase =
-    let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
-        {
-            Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
-            Attrs = unionCase.Attrs
-            Ident = unionCase.Ident
-        }
-
 [<RequireQualifiedAccess>]
 module internal SynUnionCase =
-    let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
-        match caseType with
-        | SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
-        | SynUnionCaseKind.Fields fields ->
-
-        let fields = fields |> List.map SynField.extract
-
-        let id =
-            match id with
-            | SynIdent.SynIdent (ident, _) -> ident
-
-        // 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)
-
-        {
-            Fields = fields
-            Attrs = attrs
-            Ident = id
-        }
-
     let create (case : UnionCase<Ident>) : SynUnionCase =
         let fields =
             case.Fields
@@ -63,11 +43,11 @@ module internal SynUnionCase =
             )
 
         SynUnionCase.SynUnionCase (
-            SynAttributes.ofAttrs case.Attrs,
-            SynIdent.SynIdent (case.Ident, None),
+            SynAttributes.ofAttrs case.Attributes,
+            SynIdent.createI case.Name,
             SynUnionCaseKind.Fields fields,
-            PreXmlDoc.Empty,
-            None,
+            case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
+            case.Access,
             range0,
             {
                 BarRange = Some range0

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

@@ -30,6 +30,7 @@
     <Compile Include="SynExpr\SynAttributes.fs" />
     <Compile Include="SynExpr\PreXmlDoc.fs" />
     <Compile Include="SynExpr\Ident.fs" />
+    <Compile Include="SynExpr\SynIdent.fs" />
     <Compile Include="SynExpr\SynLongIdent.fs" />
     <Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
     <Compile Include="SynExpr\SynArgPats.fs" />

WoofWare.Myriad.Plugins/version.json

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

flake.lock

@@ -20,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1725099143,
-        "narHash": "sha256-CHgumPZaC7z+WYx72WgaLt2XF0yUVzJS60rO4GZ7ytY=",
+        "lastModified": 1725534445,
+        "narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "5629520edecb69630a3f4d17d3d33fc96c13f6fe",
+        "rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39",
         "type": "github"
       },
       "original": {

global.json

@@ -1,6 +1,6 @@
 {
   "sdk": {
     "version": "8.0.100",
-    "rollForward": "latestFeature"
+    "rollForward": "latestMajor"
   }
 }

nix/deps.nix

@@ -8,8 +8,8 @@
   })
   (fetchNuGet {
     pname = "fantomas";
-    version = "6.3.11";
-    hash = "sha256-11bHGEAZTNtdp2pTg5zqLrQiyI/j/AT7GGL/2CR4+dw=";
+    version = "6.3.12";
+    hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
   })
   (fetchNuGet {
     pname = "Fantomas.Core";
@@ -78,13 +78,13 @@
   })
   (fetchNuGet {
     pname = "Microsoft.CodeCoverage";
-    version = "17.11.0";
-    hash = "sha256-XglInnx5GePUYHG7n2NLX+WfK7kJnornsWOW/5FnOXE=";
+    version = "17.11.1";
+    hash = "sha256-1dLlK3NGh88PuFYZiYpT+izA96etxhU3BSgixDgdtGA=";
   })
   (fetchNuGet {
     pname = "Microsoft.NET.Test.Sdk";
-    version = "17.11.0";
-    hash = "sha256-WjyA78+PG9ZloWTt9Hf1ek3VVj2FfJ9fAjqklnN+fWw=";
+    version = "17.11.1";
+    hash = "sha256-0JUEucQ2lzaPgkrjm/NFLBTbqU1dfhvhN3Tl3moE6mI=";
   })
   (fetchNuGet {
     pname = "Microsoft.NETCore.App.Host.linux-arm64";
@@ -153,13 +153,13 @@
   })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.ObjectModel";
-    version = "17.11.0";
-    hash = "sha256-mCI3MCV6nyrGLrBat5VvK5LrXTEKlsdp9NkpZyJYwVg=";
+    version = "17.11.1";
+    hash = "sha256-5vX+vCzFY3S7xfMVIv8OlMMFtdedW9UIJzc0WEc+vm4=";
   })
   (fetchNuGet {
     pname = "Microsoft.TestPlatform.TestHost";
-    version = "17.11.0";
-    hash = "sha256-gViDLobza22kuLvB4JdlGtbANqwBHRwf1wLmIHMw9Eo=";
+    version = "17.11.1";
+    hash = "sha256-wSkY0H1fQAq0H3LcKT4u7Y5RzhAAPa6yueVN84g8HxU=";
   })
   (fetchNuGet {
     pname = "Myriad.Core";