From bafa47fc3c6cb3570a1681c7f28cbcdc72212bad Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Thu, 26 Feb 2026 10:52:56 +0000 Subject: [PATCH 1/4] Add UseSchemaTypeNames parameter to XmlProvider for XSD type deduplication When UseSchemaTypeNames=true and a Schema is provided, elements sharing the same XSD complexType are mapped to a single F# type (named after the XSD type) instead of generating a separate per-element type. For example, with po.xsd, shipTo and billTo (both of type USAddress) previously generated XmlProvider+ShipTo and XmlProvider+BillTo as separate identical F# types. With UseSchemaTypeNames=true, both map to a single XmlProvider+USAddress type. Closes #1488 Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- RELEASE_NOTES.md | 1 + src/FSharp.Data.DesignTime/Xml/XmlProvider.fs | 12 ++++-- src/FSharp.Data.Xml.Core/XsdInference.fs | 41 ++++++++++++------- .../InferenceTests.fs | 2 +- .../TypeProviderInstantiation.fs | 9 ++-- tests/FSharp.Data.Tests/Data/shared-types.xsd | 32 +++++++++++++++ 6 files changed, 76 insertions(+), 21 deletions(-) create mode 100644 tests/FSharp.Data.Tests/Data/shared-types.xsd diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index b69a921b9..ae2ec871f 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -3,6 +3,7 @@ ## 8.1.0-beta - Add `PreferOptionals` parameter to `JsonProvider` and `XmlProvider` (defaults to `true` to match existing behavior; set to `false` to use empty string or `NaN` for missing values, like the CsvProvider default) (closes #649) +- Add `UseSchemaTypeNames` parameter to `XmlProvider`: when `true` and `Schema` is provided, multiple elements sharing the same XSD complex type generate a single F# type (named after the XSD type) instead of separate per-element types (closes #1488) ## 8.0.0 - Feb 25 2026 diff --git a/src/FSharp.Data.DesignTime/Xml/XmlProvider.fs b/src/FSharp.Data.DesignTime/Xml/XmlProvider.fs index bb7b9cdbf..7a3ebda18 100644 --- a/src/FSharp.Data.DesignTime/Xml/XmlProvider.fs +++ b/src/FSharp.Data.DesignTime/Xml/XmlProvider.fs @@ -54,6 +54,7 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = let dtdProcessing = args.[11] :?> string let useOriginalNames = args.[12] :?> bool let preferOptionals = args.[13] :?> bool + let useSchemaTypeNames = args.[14] :?> bool let inferenceMode = InferenceMode'.FromPublicApi(inferenceMode, inferTypesFromValues) @@ -79,7 +80,10 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = use _holder = IO.logTime "Inference" sample let t = - schemaSet |> XsdParsing.getElements |> List.ofSeq |> XsdInference.inferElements + schemaSet + |> XsdParsing.getElements + |> List.ofSeq + |> XsdInference.inferElements useSchemaTypeNames #if NET6_0_OR_GREATER if preferDateOnly && ProviderHelpers.runtimeSupportsNet6Types cfg.RuntimeAssembly then t @@ -205,7 +209,8 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = ProvidedStaticParameter("PreferDateOnly", typeof, parameterDefaultValue = false) ProvidedStaticParameter("DtdProcessing", typeof, parameterDefaultValue = "Ignore") ProvidedStaticParameter("UseOriginalNames", typeof, parameterDefaultValue = false) - ProvidedStaticParameter("PreferOptionals", typeof, parameterDefaultValue = true) ] + ProvidedStaticParameter("PreferOptionals", typeof, parameterDefaultValue = true) + ProvidedStaticParameter("UseSchemaTypeNames", typeof, parameterDefaultValue = false) ] let helpText = """Typed representation of a XML file. @@ -232,7 +237,8 @@ type public XmlProvider(cfg: TypeProviderConfig) as this = When true on .NET 6+, date-only strings are inferred as DateOnly and time-only strings as TimeOnly. Defaults to false for backward compatibility. Controls how DTD declarations in the XML are handled. Accepted values: "Ignore" (default, silently skips DTD processing, safe for most cases), "Prohibit" (throws on any DTD declaration), "Parse" (enables full DTD processing including entity expansion, use with caution). When true, XML element and attribute names are used as-is for generated property names instead of being normalized to PascalCase. Defaults to false. - When set to true (default), inference will use the option type for missing or absent values. When false, inference will prefer to use empty string or double.NaN for missing values where possible, matching the default CsvProvider behavior.""" + When set to true (default), inference will use the option type for missing or absent values. When false, inference will prefer to use empty string or double.NaN for missing values where possible, matching the default CsvProvider behavior. + When true and a Schema is provided, the XSD complex type name is used for the generated F# type instead of the element name. This causes multiple elements that share the same XSD type to map to a single F# type. Defaults to false for backward compatibility.""" do xmlProvTy.AddXmlDoc helpText diff --git a/src/FSharp.Data.Xml.Core/XsdInference.fs b/src/FSharp.Data.Xml.Core/XsdInference.fs index 6b3212374..a08b7f078 100644 --- a/src/FSharp.Data.Xml.Core/XsdInference.fs +++ b/src/FSharp.Data.Xml.Core/XsdInference.fs @@ -40,7 +40,8 @@ module XsdModel = | ComplexType of XsdComplexType and [] XsdComplexType = - { Attributes: (XmlQualifiedName * XmlTypeCode * IsOptional) list + { Name: XmlQualifiedName option + Attributes: (XmlQualifiedName * XmlTypeCode * IsOptional) list Contents: XsdContent } and XsdContent = @@ -150,7 +151,12 @@ module XsdParsing = result and parseComplexType ctx (x: XmlSchemaComplexType) = - { Attributes = + { Name = + if x.QualifiedName.IsEmpty then + None + else + Some x.QualifiedName + Attributes = x.AttributeUses.Values |> ofType |> Seq.filter (fun a -> a.Use <> XmlSchemaUse.Prohibited) @@ -274,8 +280,14 @@ module internal XsdInference = type InferenceContext = System.Collections.Generic.Dictionary // derives an InferedType for an element definition - let rec inferElementType ctx elm = - let name = getElementName elm + let rec inferElementType useSchemaTypeNames ctx (elm: XsdElement) = + let name = + if useSchemaTypeNames then + match elm.Type with + | ComplexType cty when cty.Name.IsSome -> Some(formatName cty.Name.Value) + | _ -> getElementName elm + else + getElementName elm if elm.IsAbstract then InferedType.Record(name, [], optional = false) @@ -287,7 +299,7 @@ module internal XsdInference = let props = if elm.IsNillable then [ prop; nil ] else [ prop ] InferedType.Record(name, props, optional = false) | ComplexType cty -> - let props = inferProperties ctx cty + let props = inferProperties useSchemaTypeNames ctx cty let props = if elm.IsNillable then @@ -301,7 +313,7 @@ module internal XsdInference = InferedType.Record(name, props, optional = false) - and inferProperties (ctx: InferenceContext) cty = + and inferProperties useSchemaTypeNames (ctx: InferenceContext) cty = let attrs: InferedProperty list = cty.Attributes |> List.map (fun (name, typeCode, optional) -> @@ -328,14 +340,14 @@ module internal XsdInference = let getRecordTag (e: XsdElement) = InferedTypeTag.Record(getElementName e) result.Type <- - match getElements ctx Single xsdParticle with + match getElements useSchemaTypeNames ctx Single xsdParticle with | [] -> InferedType.Null | items -> let tags = items |> List.map (fst >> getRecordTag) let types = items - |> List.map (fun (e, m) -> m, inferElementType ctx e) + |> List.map (fun (e, m) -> m, inferElementType useSchemaTypeNames ctx e) |> Seq.zip tags |> Map.ofSeq @@ -349,7 +361,7 @@ module internal XsdInference = body :: attrs // collects element definitions in a particle - and getElements ctx parentMultiplicity = + and getElements useSchemaTypeNames ctx parentMultiplicity = function | XsdParticle.Element(occ, elm) -> let mult = combineMultiplicity (parentMultiplicity, getMultiplicity occ) @@ -362,23 +374,24 @@ module internal XsdInference = | XsdParticle.Sequence(occ, particles) | XsdParticle.All(occ, particles) -> let mult = combineMultiplicity (parentMultiplicity, getMultiplicity occ) - particles |> List.collect (getElements ctx mult) + particles |> List.collect (getElements useSchemaTypeNames ctx mult) | XsdParticle.Choice(occ, particles) -> let mult = makeOptional (getMultiplicity occ) let mult' = combineMultiplicity (parentMultiplicity, mult) - particles |> List.collect (getElements ctx mult') + particles |> List.collect (getElements useSchemaTypeNames ctx mult') | XsdParticle.Empty -> [] | XsdParticle.Any _ -> [] - let inferElements elms = + let inferElements useSchemaTypeNames elms = let ctx = InferenceContext() match elms |> List.filter (fun elm -> not elm.IsAbstract) with | [] -> failwith "No suitable element definition found in the schema." - | [ elm ] -> inferElementType ctx elm + | [ elm ] -> inferElementType useSchemaTypeNames ctx elm | elms -> elms - |> List.map (fun elm -> InferedTypeTag.Record(getElementName elm), inferElementType ctx elm) + |> List.map (fun elm -> + InferedTypeTag.Record(getElementName elm), inferElementType useSchemaTypeNames ctx elm) |> Map.ofList |> (fun x -> InferedType.Heterogeneous(x, false)) diff --git a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs index d97e6461e..b7d5f128f 100644 --- a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs +++ b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs @@ -444,7 +444,7 @@ let internal getInferedTypeFromSchema xsd = |> XmlSchema.parseSchema "" |> XsdParsing.getElements |> List.ofSeq - |> XsdInference.inferElements + |> XsdInference.inferElements false let internal isValid xsd = let xmlSchemaSet = XmlSchema.parseSchema "" xsd diff --git a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs index 2e004b464..53e87af41 100644 --- a/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs +++ b/tests/FSharp.Data.DesignTime.Tests/TypeProviderInstantiation.fs @@ -45,7 +45,8 @@ type internal XmlProviderArgs = PreferDateOnly : bool DtdProcessing : string UseOriginalNames : bool - PreferOptionals : bool } + PreferOptionals : bool + UseSchemaTypeNames : bool } type internal JsonProviderArgs = { Sample : string @@ -126,7 +127,8 @@ type internal TypeProviderInstantiation = box x.PreferDateOnly box x.DtdProcessing box x.UseOriginalNames - box x.PreferOptionals |] + box x.PreferOptionals + box x.UseSchemaTypeNames |] | Json x -> (fun cfg -> new JsonProvider(cfg) :> TypeProviderForNamespaces), [| box x.Sample @@ -268,7 +270,8 @@ type internal TypeProviderInstantiation = PreferDateOnly = false DtdProcessing = "Ignore" UseOriginalNames = false - PreferOptionals = true } + PreferOptionals = true + UseSchemaTypeNames = false } | "Json" -> // Handle special case for Schema.json tests where some fields might be empty if args.Length > 5 && not (String.IsNullOrEmpty(args.[5])) then diff --git a/tests/FSharp.Data.Tests/Data/shared-types.xsd b/tests/FSharp.Data.Tests/Data/shared-types.xsd new file mode 100644 index 000000000..281313d7e --- /dev/null +++ b/tests/FSharp.Data.Tests/Data/shared-types.xsd @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 83dd34d12db40dddeb073373b412680fe09d5dd4 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Thu, 26 Feb 2026 10:56:09 +0000 Subject: [PATCH 2/4] ci: trigger CI checks From aa049e70fb49e6e5c89115ba784b148a7a51019e Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Thu, 26 Feb 2026 15:17:00 +0000 Subject: [PATCH 3/4] Add tests for UseSchemaTypeNames XmlProvider parameter - InferenceTests: add unit tests for XsdInference.inferElements with useSchemaTypeNames=true/false, verifying that shared XSD complex types produce correctly named InferedType.Record entries and that anonymous types still use element names - XmlProvider.fs: add integration tests using inline schema and shared-types.xsd with UseSchemaTypeNames=true, verifying that shipTo and billTo (both AddressType) produce the same .NET type and that field values are parsed correctly Closes the gap identified in #1663: shared-types.xsd was added as test data but not actually referenced in any test. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../InferenceTests.fs | 103 ++++++++++++++++++ tests/FSharp.Data.Tests/XmlProvider.fs | 58 ++++++++++ 2 files changed, 161 insertions(+) diff --git a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs index b7d5f128f..f5592940f 100644 --- a/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs +++ b/tests/FSharp.Data.DesignTime.Tests/InferenceTests.fs @@ -446,6 +446,13 @@ let internal getInferedTypeFromSchema xsd = |> List.ofSeq |> XsdInference.inferElements false +let internal getInferedTypeFromSchemaWithTypeNames xsd = + xsd + |> XmlSchema.parseSchema "" + |> XsdParsing.getElements + |> List.ofSeq + |> XsdInference.inferElements true + let internal isValid xsd = let xmlSchemaSet = XmlSchema.parseSchema "" xsd fun xml -> @@ -966,3 +973,99 @@ let ``circular group references do not cause a stack overflow``() = // Must complete without StackOverflowException getInferedTypeFromSchema xsd |> ignore +// Schema with shared complex types, used to test UseSchemaTypeNames +let private sharedTypesXsd = + """ + + + + + + + + + + + + + + + + + + + + + + + + + + """ + +// Extracts the record type name for a child element from the body Collection inside a top-level Record. +// The body property has Name = "" and type InferedType.Collection whose Map keys are InferedTypeTag.Record +// (keyed by element name) and whose values are (multiplicity, InferedType.Record(typeName, ...)). +let private getChildRecordName (elementName: string) ty = + match ty with + | InferedType.Record(_, props, _) -> + let body = props |> List.find (fun p -> p.Name = "") + + match body.Type with + | InferedType.Collection(_, types) -> + let key = InferedTypeTag.Record(Some elementName) + + match types |> Map.tryFind key with + | Some(_, InferedType.Record(name, _, _)) -> name + | Some(_, t) -> failwithf "Expected Record for element '%s', got %A" elementName t + | None -> failwithf "Element '%s' not found in Collection; keys: %A" elementName (types |> Map.toList |> List.map fst) + | t -> failwithf "Expected Collection body property, got %A" t + | _ -> failwithf "Expected top-level Record, got %A" ty + +[] +let ``UseSchemaTypeNames false: child elements use element names as record type names``() = + let ty = getInferedTypeFromSchema sharedTypesXsd + + match ty with + | InferedType.Record(Some "order", _, _) -> + getChildRecordName "shipTo" ty |> should equal (Some "shipTo") + getChildRecordName "billTo" ty |> should equal (Some "billTo") + getChildRecordName "contact" ty |> should equal (Some "contact") + | _ -> failwithf "Expected Record(Some 'order'), got %A" ty + +[] +let ``UseSchemaTypeNames true: shared complex types get XSD type name``() = + let ty = getInferedTypeFromSchemaWithTypeNames sharedTypesXsd + + // The root element itself is named after its XSD type + match ty with + | InferedType.Record(Some "OrderType", _, _) -> + // Both shipTo and billTo reference AddressType, so both should get the XSD type name + getChildRecordName "shipTo" ty |> should equal (Some "AddressType") + getChildRecordName "billTo" ty |> should equal (Some "AddressType") + getChildRecordName "contact" ty |> should equal (Some "PersonType") + | _ -> failwithf "Expected Record(Some 'OrderType'), got %A" ty + +[] +let ``UseSchemaTypeNames true: anonymous types still use element names``() = + let xsd = + """ + + + + + + + + + + """ + + let ty = getInferedTypeFromSchemaWithTypeNames xsd + + // Root element uses anonymous inline type — no named XSD type, so element name is used + match ty with + | InferedType.Record(Some "root", _, _) -> () + | _ -> failwithf "Expected Record(Some 'root'), got %A" ty + + diff --git a/tests/FSharp.Data.Tests/XmlProvider.fs b/tests/FSharp.Data.Tests/XmlProvider.fs index 2c551eeba..323b4305e 100644 --- a/tests/FSharp.Data.Tests/XmlProvider.fs +++ b/tests/FSharp.Data.Tests/XmlProvider.fs @@ -1359,3 +1359,61 @@ let ``XmlProvider PreferOptionals=false uses empty string for missing string att let root = XmlPreferOptionalsFalse.Parse("""""") root.Items.[0].Tag.GetType() |> should equal typeof root.Items.[0].Tag |> should equal "" + +// Tests for UseSchemaTypeNames parameter on XmlProvider (issue #1488) +type XmlSharedTypes = + XmlProvider< + Schema = """ + + + + + + + + + + + + + + + + """, + UseSchemaTypeNames = true> + +[] +let ``XmlProvider UseSchemaTypeNames=true: shipTo and billTo share the same generated F# type`` () = + let order = + XmlSharedTypes.Parse( + """1 MainSpringfield + 2 OakShelbyville""" + ) + + order.Id |> should equal "1" + order.ShipTo.Street |> should equal "1 Main" + order.BillTo.City |> should equal "Shelbyville" + // Both shipTo and billTo reference AddressType, so they must have the same .NET type + order.ShipTo.GetType() |> should equal (order.BillTo.GetType()) + +type XmlSharedTypesFile = + XmlProvider + +[] +let ``XmlProvider UseSchemaTypeNames=true with shared-types.xsd: shipTo and billTo share AddressType`` () = + let order = + XmlSharedTypesFile.Parse( + """ + 123 Main StSpringfield12345 + 456 Oak AveShelbyville67890 + """ + ) + + order.Id |> should equal "ORD-001" + order.ShipTo.Street |> should equal "123 Main St" + order.ShipTo.Country |> should equal (Some "US") + order.BillTo.City |> should equal "Shelbyville" + order.BillTo.Zip |> should equal "67890" + order.Contact |> should equal None + // Both elements share the same XSD AddressType, so the generated .NET types must match + order.ShipTo.GetType() |> should equal (order.BillTo.GetType()) From 913326472cf8f4c73bd8b7310e4a3e2f1b591062 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Thu, 26 Feb 2026 15:18:56 +0000 Subject: [PATCH 4/4] ci: trigger CI checks