Scope generated opens to the tagged type's namespace block

Every generator previously emitted every `open` from the whole input file
into every generated namespace (via Whippet's AstHelper.extractOpens,
which shadows the identically-named dead local helper). A relative open
that is valid in one namespace block is not necessarily valid in another,
so generated code for a type in a different block could fail to compile.

extractOpensForNamespace collects opens only from the namespace blocks
whose name is a segment-wise prefix of the tagged type's namespace:
prefix rather than exact matching because CataGenerator's type discovery
descends into nested modules (a type in module M of namespace N is
reported as N.M, and block N's opens are lexically in scope around it).
Same-named blocks share a resolution context, so unioning them is sound.
The dead local extractOpens is replaced.

ConsumePlugin/OpensLeakRegression.fs is a compile-time regression test:
its bait block contains a relative `open RelativeOpenBait` which does
not resolve in the victim namespace, so the pre-fix generator produces
uncompilable output for it (verified against the pre-fix plugin).

No checked-in generated code changes: no existing input relied on the leak.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

Author: Smaug123

ConsumePlugin/ConsumePlugin.fsproj

@@ -100,6 +100,10 @@
     <Compile Include="GeneratedArgParserNegationTests.fs">
       <MyriadFile>ArgParserNegationTests.fs</MyriadFile>
     </Compile>
+    <Compile Include="OpensLeakRegression.fs" />
+    <Compile Include="GeneratedOpensLeakRegression.fs">
+      <MyriadFile>OpensLeakRegression.fs</MyriadFile>
+    </Compile>
     <!-- Not compiled, because by design they *don't* compile. That makes them very hard to test in an automated way! -->
     <None Include="ArgParserConflictTests.fs" />
     <!-- To run the conflict tests:

ConsumePlugin/GeneratedOpensLeakRegression.fs

@@ -0,0 +1,156 @@
+//------------------------------------------------------------------------------
+//        This code was generated by myriad.
+//        Changes to this file will be lost when the code is regenerated.
+//------------------------------------------------------------------------------
+
+
+
+
+
+
+
+namespace ConsumePlugin.OpensLeakVictim
+
+open WoofWare.Myriad.Plugins
+
+/// Methods to parse arguments for the type LeakArgs
+[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+module LeakArgs =
+    type private ParseState_LeakArgs =
+        /// Ready to consume a key or positional arg
+        | AwaitingKey
+        /// Waiting to receive a value for the key we've already consumed
+        | AwaitingValue of key : string
+
+    let parse' (getEnvironmentVariable : string -> string option) (args : string list) : LeakArgs =
+        let ArgParser_errors = ResizeArray ()
+
+        let helpText () =
+            [ (sprintf "%s  int32%s%s" (sprintf "--%s" "foo") "" "") ] |> String.concat "\n"
+
+        let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
+        let mutable arg_0 : int option = None
+
+        /// Processes the key-value pair, returning Error if no key was matched.
+        /// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
+        /// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
+        let processKeyValue (key : string) (value : string) : Result<unit, string option> =
+            if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then
+                match arg_0 with
+                | Some x ->
+                    sprintf
+                        "Argument '%s' was supplied multiple times: %s and %s"
+                        (sprintf "--%s" "foo")
+                        (x.ToString ())
+                        (value.ToString ())
+                    |> ArgParser_errors.Add
+
+                    Ok ()
+                | None ->
+                    try
+                        arg_0 <- value |> (fun x -> System.Int32.Parse x) |> Some
+                        Ok ()
+                    with _ as exc ->
+                        exc.Message |> Some |> Error
+            else
+                Error None
+
+        /// Returns false if we didn't set a value.
+        let setFlagValue (key : string) : bool = false
+
+        let rec go (state : ParseState_LeakArgs) (args : string list) =
+            match args with
+            | [] ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey -> ()
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    if setFlagValue key then
+                        ()
+                    else
+                        sprintf
+                            "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                            key
+                        |> ArgParser_errors.Add
+            | "--" :: rest ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey -> ()
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    if setFlagValue key then
+                        ()
+                    else
+                        sprintf
+                            "Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
+                            key
+                        |> ArgParser_errors.Add
+
+                parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
+            | arg :: args ->
+                match state with
+                | ParseState_LeakArgs.AwaitingKey ->
+                    if arg.StartsWith ("--", System.StringComparison.Ordinal) then
+                        if arg = "--help" then
+                            helpText () |> failwithf "Help text requested.\n%s"
+                        else
+                            let equals = arg.IndexOf (char 61)
+
+                            if equals < 0 then
+                                args |> go (ParseState_LeakArgs.AwaitingValue arg)
+                            else
+                                let key = arg.[0 .. equals - 1]
+                                let value = arg.[equals + 1 ..]
+
+                                match processKeyValue key value with
+                                | Ok () -> go ParseState_LeakArgs.AwaitingKey args
+                                | Error x ->
+                                    match x with
+                                    | None ->
+                                        failwithf "Unable to process argument %s as key %s and value %s" arg key value
+                                    | Some msg ->
+                                        sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
+                                        go ParseState_LeakArgs.AwaitingKey args
+                    else
+                        arg |> (fun x -> x) |> parser_LeftoverArgs.Add
+                        go ParseState_LeakArgs.AwaitingKey args
+                | ParseState_LeakArgs.AwaitingValue key ->
+                    match processKeyValue key arg with
+                    | Ok () -> go ParseState_LeakArgs.AwaitingKey args
+                    | Error exc ->
+                        if setFlagValue key then
+                            go ParseState_LeakArgs.AwaitingKey (arg :: args)
+                        else
+                            match exc with
+                            | None ->
+                                failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
+                            | Some msg -> msg |> ArgParser_errors.Add
+
+        go ParseState_LeakArgs.AwaitingKey args
+
+        let parser_LeftoverArgs =
+            if 0 = parser_LeftoverArgs.Count then
+                ()
+            else
+                parser_LeftoverArgs
+                |> String.concat " "
+                |> sprintf "There were leftover args: %s"
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+
+        let arg_0 =
+            match arg_0 with
+            | None ->
+                sprintf "Required argument '%s' received no value" (sprintf "--%s" "foo")
+                |> ArgParser_errors.Add
+
+                Unchecked.defaultof<_>
+            | Some x -> x
+
+        if 0 = ArgParser_errors.Count then
+            {
+                Foo = arg_0
+            }
+        else
+            ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
+
+    let parse (args : string list) : LeakArgs =
+        parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

ConsumePlugin/OpensLeakRegression.fs

@@ -0,0 +1,30 @@
+// Regression test for the opens leak: `open` declarations from one namespace block of an input
+// file must not appear in generated code for a *different* namespace block. The bait below is a
+// relative `open RelativeOpenBait`, which resolves only from within ConsumePlugin.OpensLeak; if
+// it leaked into the generated module for ConsumePlugin.OpensLeakVictim, this project would fail
+// to compile.
+namespace ConsumePlugin.OpensLeak
+
+module internal RelativeOpenBait =
+    let internal bait : int = 1
+
+namespace ConsumePlugin.OpensLeak
+
+open RelativeOpenBait
+
+type UsesTheBait =
+    {
+        Ignored : int
+    }
+
+    static member internal Use () : int = bait
+
+namespace ConsumePlugin.OpensLeakVictim
+
+open WoofWare.Myriad.Plugins
+
+[<ArgParser>]
+type LeakArgs =
+    {
+        Foo : int
+    }

WoofWare.Myriad.Plugins.Test/TestAstHelper.fs

@@ -0,0 +1,72 @@
+namespace WoofWare.Myriad.Plugins.Test
+
+open NUnit.Framework
+open FsUnitTyped
+open Fantomas.FCS.Syntax
+open WoofWare.Whippet.Fantomas
+open WoofWare.Myriad.Plugins
+
+[<TestFixture>]
+module TestAstHelper =
+
+    /// Render an open target as its dotted path, for easy comparison.
+    let private renderOpen (target : SynOpenDeclTarget) : string =
+        match target with
+        | SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.SynLongIdent (ident, _, _), _) ->
+            ident |> List.map _.idText |> String.concat "."
+        | SynOpenDeclTarget.Type _ -> failwith "open type not expected in these tests"
+
+    let private opensFor (ns : string) (source : string) : string list =
+        let ast = Ast.parse source
+        let nsIdent = ns.Split '.' |> Seq.map Ident.create |> List.ofSeq
+        AstHelper.extractOpensForNamespace nsIdent ast |> List.map renderOpen
+
+    let private source : string =
+        """namespace First
+
+open System.IO
+
+module Helpers =
+    let x = 1
+
+namespace First
+
+open Helpers
+
+namespace First.Unrelated
+
+open System.Text
+
+namespace Second
+
+open System.Collections.Generic
+"""
+
+    [<Test>]
+    let ``An exactly-matching block contributes its opens verbatim`` () =
+        // Both blocks named First match; neither gets a context-restoring prefix open.
+        opensFor "First" source |> shouldEqual [ "System.IO" ; "Helpers" ]
+
+    [<Test>]
+    let ``Opens from unrelated blocks do not leak`` () =
+        opensFor "Second" source |> shouldEqual [ "System.Collections.Generic" ]
+
+    [<Test>]
+    let ``An ancestor block's opens are preceded by an absolute open of that block`` () =
+        // A type discovered inside `module M` of block First is reported with namespace First.M;
+        // block First's opens apply, but its relative opens (open Helpers) only resolve once the
+        // ancestor block is itself opened absolutely.
+        opensFor "First.M" source
+        |> shouldEqual [ "First" ; "System.IO" ; "First" ; "Helpers" ]
+
+    [<Test>]
+    let ``Sibling namespaces sharing a name prefix segment do not match non-segment-wise`` () =
+        // "First.Unrelated" is not an ancestor of "First.UnrelatedM"; only segment-wise prefixes
+        // count, so "First.Unrel" style string prefixes must not match either.
+        opensFor "First.UnrelatedM" source
+        |> shouldEqual [ "First" ; "System.IO" ; "First" ; "Helpers" ]
+
+    [<Test>]
+    let ``A block with no opens contributes nothing, not even a context open`` () =
+        opensFor "Second.M.Deep" "namespace Second.M\n\ntype T = { F : int }\n"
+        |> shouldEqual []

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

@@ -61,6 +61,7 @@
     <EmbeddedResource Include="TestSwagger\uspto.json" />
     <EmbeddedResource Include="TestSwagger\webhook-example.json" />
     <Compile Include="TestRemoveOptions.fs" />
+    <Compile Include="TestAstHelper.fs" />
     <Compile Include="TestSurface.fs" />
     <None Include="../.github/workflows/dotnet.yaml" />
   </ItemGroup>

WoofWare.Myriad.Plugins/ArgParserGenerator.fs

@@ -2148,6 +2148,7 @@ type ArgParserGenerator () =
             let modules =
                 namespaceAndTypes
                 |> List.map (fun (ns, taggedType, unions, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     ArgParserGenerator.createModule opens ns taggedType unions records
                 )
 

WoofWare.Myriad.Plugins/AstHelper.fs

@@ -57,11 +57,57 @@ module internal AstHelper =
             | _ -> None
         )
 
-    let extractOpens (ast : ParsedInput) : SynOpenDeclTarget list =
+    /// Extract the `open` declarations which are in scope for generated code emitted into
+    /// namespace `ns`: the opens of every top-level namespace/module block of the file whose name
+    /// is a segment-wise prefix of `ns`.
+    ///
+    /// Prefix (rather than exact) matching is needed because type discovery descends into nested
+    /// modules: a type inside `module M` of `namespace N` is reported with namespace `N.M`, and
+    /// the opens of block `N` are lexically in scope around it. Opens of blocks whose name is not
+    /// a prefix must not leak in: a relative `open` which is valid in one namespace block can be
+    /// invalid (or resolve to something else) in another. Two blocks with the same name share a
+    /// resolution context, so it is sound to union their opens.
+    ///
+    /// A *strict*-prefix ancestor block's opens may themselves be relative to that block (e.g.
+    /// `open Helpers` for a `module Helpers` in the same block), and relative opens do not
+    /// resolve across blocks: `namespace N.M` cannot `open Bait` to reach `N.Bait`. So before an
+    /// ancestor block's opens we emit an absolute open of the ancestor block itself, which
+    /// re-establishes its resolution context (F# resolves later opens through earlier ones).
+    ///
+    /// (Note: this deliberately does not share a name with WoofWare.Whippet.Fantomas's
+    /// `AstHelper.extractOpens`, which shadows this module's members at generator call sites and
+    /// extracts opens from *every* block in the file.)
+    let extractOpensForNamespace (ns : LongIdent) (ast : ParsedInput) : SynOpenDeclTarget list =
+        let nsName = ns |> List.map _.idText
+
+        let isPrefixOfNs (blockName : string list) : bool =
+            List.length blockName <= List.length nsName
+            && List.forall2
+                (fun (a : string) (b : string) -> System.String.Equals (a, b, System.StringComparison.Ordinal))
+                blockName
+                (List.truncate (List.length blockName) nsName)
+
         match ast with
         | ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
             modules
-            |> List.collect (fun (SynModuleOrNamespace (_, _, _, decls, _, _, _, _, _)) -> extractOpensFromDecl decls)
+            |> List.collect (fun (SynModuleOrNamespace (longId, _, _, decls, _, _, _, _, _)) ->
+                let blockName = longId |> List.map _.idText
+
+                if not (isPrefixOfNs blockName) then
+                    []
+                else
+
+                match extractOpensFromDecl decls with
+                | [] -> []
+                | opens ->
+                    if List.length blockName = List.length nsName then
+                        // The block *is* the target namespace: its opens are valid verbatim.
+                        opens
+                    else
+                        // Strict-prefix ancestor: re-establish its resolution context first.
+                        SynOpenDeclTarget.ModuleOrNamespace (SynLongIdent.create longId, range0)
+                        :: opens
+            )
         | _ -> []
 
     let rec convertSigParam (ty : SynType) : ParameterInfo * bool =

WoofWare.Myriad.Plugins/CapturingInterfaceMockGenerator.fs

@@ -735,11 +735,10 @@ type CapturingInterfaceMockGenerator () =
                         | ty -> Some (ns, ty)
                 )
 
-            let opens = AstHelper.extractOpens ast
-
             let modules =
                 namespaceAndInterfaces
                 |> List.collect (fun (ns, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     records |> List.map (CapturingInterfaceMockGenerator.createRecord ns opens)
                 )
 

WoofWare.Myriad.Plugins/CataGenerator.fs

@@ -1266,6 +1266,7 @@ type CreateCatamorphismGenerator () =
             let modules =
                 namespaceAndTypes
                 |> List.map (fun (ns, taggedType, unions, records) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
                     CataGenerator.createModule opens ns taggedType unions records
                 )
 

WoofWare.Myriad.Plugins/HttpClientGenerator.fs

@@ -1294,6 +1294,9 @@ type HttpClientGenerator () =
 
             let modules =
                 namespaceAndTypes
-                |> List.collect (fun (ns, types) -> types |> List.map (HttpClientGenerator.createModule opens ns))
+                |> List.collect (fun (ns, types) ->
+                    let opens = AstHelper.extractOpensForNamespace ns ast
+                    types |> List.map (HttpClientGenerator.createModule opens ns)
+                )
 
             Output.Ast modules