From e14fc8dcc173a6a03bc7440aa386e80b31043239 Mon Sep 17 00:00:00 2001 From: Mark Probst Date: Mon, 20 Jul 2026 16:38:00 -0400 Subject: [PATCH 1/5] fix(haskell): don't rename enum cases for forbidden identifiers when the enum suffix already disambiguates (#2868) Co-Authored-By: gpt-5.6-sol via pi --- .../src/language/Haskell/HaskellRenderer.ts | 38 ++++++++++++++++--- .../schema/haskell-enum-forbidden.1.json | 3 ++ .../schema/haskell-enum-forbidden.schema | 11 ++++++ test/languages.ts | 6 ++- 4 files changed, 51 insertions(+), 7 deletions(-) create mode 100644 test/inputs/schema/haskell-enum-forbidden.1.json create mode 100644 test/inputs/schema/haskell-enum-forbidden.schema diff --git a/packages/quicktype-core/src/language/Haskell/HaskellRenderer.ts b/packages/quicktype-core/src/language/Haskell/HaskellRenderer.ts index df24ab19ef..c27c27f0f2 100644 --- a/packages/quicktype-core/src/language/Haskell/HaskellRenderer.ts +++ b/packages/quicktype-core/src/language/Haskell/HaskellRenderer.ts @@ -4,7 +4,7 @@ import { ConvenienceRenderer, type ForbiddenWordsInfo, } from "../../ConvenienceRenderer.js"; -import type { Name, Namer } from "../../Naming.js"; +import { DependencyName, type Name, type Namer } from "../../Naming.js"; import type { RenderContext } from "../../Renderer.js"; import type { OptionValues } from "../../RendererOptions/index.js"; import { @@ -73,6 +73,26 @@ export class HaskellRenderer extends ConvenienceRenderer { return true; } + protected makeNameForEnumCase( + e: EnumType, + enumName: Name, + caseName: string, + assignedName: string | undefined, + ): Name { + const name = super.makeNameForEnumCase( + e, + enumName, + caseName, + assignedName, + ); + const proposedName = name.firstProposedName(new Map()); + return new DependencyName( + name.namingFunction, + name.order, + (lookup) => `${proposedName}_${lookup(enumName)}`, + ); + } + protected proposeUnionMemberName( u: UnionType, unionName: Name, @@ -226,6 +246,10 @@ export class HaskellRenderer extends ConvenienceRenderer { }); } + private enumCaseName(name: Name, enumName: Name): Sourcelike { + return name instanceof DependencyName ? name : [name, enumName]; + } + private emitEnumDefinition(e: EnumType, enumName: Name): void { this.emitDescription(this.descriptionForType(e)); this.emitLine("data ", enumName); @@ -233,7 +257,11 @@ export class HaskellRenderer extends ConvenienceRenderer { let onFirst = true; this.forEachEnumCase(e, "none", (name) => { const equalsOrPipe = onFirst ? "=" : "|"; - this.emitLine(equalsOrPipe, " ", name, enumName); + this.emitLine( + equalsOrPipe, + " ", + this.enumCaseName(name, enumName), + ); onFirst = false; }); this.emitLine("deriving (Show)"); @@ -355,8 +383,7 @@ export class HaskellRenderer extends ConvenienceRenderer { this.forEachEnumCase(e, "none", (name, jsonName) => { this.emitLine( "toJSON ", - name, - enumName, + this.enumCaseName(name, enumName), ' = "', stringEscape(jsonName), '"', @@ -377,8 +404,7 @@ export class HaskellRenderer extends ConvenienceRenderer { 'parseText "', stringEscape(jsonName), '" = return ', - name, - enumName, + this.enumCaseName(name, enumName), ); }); }); diff --git a/test/inputs/schema/haskell-enum-forbidden.1.json b/test/inputs/schema/haskell-enum-forbidden.1.json new file mode 100644 index 0000000000..1513721d9a --- /dev/null +++ b/test/inputs/schema/haskell-enum-forbidden.1.json @@ -0,0 +1,3 @@ +{ + "health": "error" +} diff --git a/test/inputs/schema/haskell-enum-forbidden.schema b/test/inputs/schema/haskell-enum-forbidden.schema new file mode 100644 index 0000000000..c06f971a56 --- /dev/null +++ b/test/inputs/schema/haskell-enum-forbidden.schema @@ -0,0 +1,11 @@ +{ + "$schema": "http://json-schema.org/draft-06/schema#", + "type": "object", + "properties": { + "health": { + "type": "string", + "enum": ["ok", "error"] + } + }, + "required": ["health"] +} diff --git a/test/languages.ts b/test/languages.ts index 6bcfd43611..c37ad1a3ce 100644 --- a/test/languages.ts +++ b/test/languages.ts @@ -1691,7 +1691,11 @@ export const HaskellLanguage: Language = { setupCommand: "stack install", compileCommand: "true", runCommand(sample: string) { - return `stack run haskell -- "${sample}"`; + // Round-tripping cannot distinguish generated constructor names. + const sourceCheck = sample.endsWith("haskell-enum-forbidden.1.json") + ? "grep -q '^ = ErrorHealth$' QuickType.hs && " + : ""; + return `${sourceCheck}stack run haskell -- "${sample}"`; }, diffViaSchema: true, skipDiffViaSchema: [ From 2fe8ce9219b1bc5c0d085ac49a139c7af9521368 Mon Sep 17 00:00:00 2001 From: Mark Probst Date: Mon, 20 Jul 2026 19:49:27 -0400 Subject: [PATCH 2/5] test: add missing fixture cases for haskell-enum-forbidden.schema (#2969) Co-Authored-By: Claude --- test/inputs/schema/haskell-enum-forbidden.1.fail.enum.json | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 test/inputs/schema/haskell-enum-forbidden.1.fail.enum.json diff --git a/test/inputs/schema/haskell-enum-forbidden.1.fail.enum.json b/test/inputs/schema/haskell-enum-forbidden.1.fail.enum.json new file mode 100644 index 0000000000..d38b6a8168 --- /dev/null +++ b/test/inputs/schema/haskell-enum-forbidden.1.fail.enum.json @@ -0,0 +1,3 @@ +{ + "health": "warning" +} From b75e57f19f20f182f5ef363cf47f731698c1f373 Mon Sep 17 00:00:00 2001 From: Mark Probst Date: Mon, 20 Jul 2026 22:12:15 -0400 Subject: [PATCH 3/5] fix CI: skip cjson enum-value validation for haskell-enum-forbidden.schema (#2868) The new haskell-enum-forbidden.1.fail.enum.json fail sample runs against every language with the "enum" feature, including cjson. cJSON's generated enum getters silently fall back to the first enum member on an unrecognized string instead of failing, the same pre-existing limitation already documented and worked around for enum.schema, enum-large.schema, optional-enum.schema, and const-non-string.schema via the shared skipsEnumValueValidation list. Add the new schema to that list. Co-Authored-By: gpt-5.6-sol via pi --- test/languages.ts | 1 + 1 file changed, 1 insertion(+) diff --git a/test/languages.ts b/test/languages.ts index c37ad1a3ce..be09d6eca6 100644 --- a/test/languages.ts +++ b/test/languages.ts @@ -25,6 +25,7 @@ const skipsEnumValueValidation = [ "enum-large.schema", "optional-enum.schema", "const-non-string.schema", + "haskell-enum-forbidden.schema", ]; // The language makes no int/double distinction in unions (e.g. an integer is From 8623b537052156f7cd248b434d3d02b1780a83f2 Mon Sep 17 00:00:00 2001 From: Mark Probst Date: Tue, 21 Jul 2026 09:18:59 -0400 Subject: [PATCH 4/5] chore: retrigger CI No workflow run was created for the previous push (b75e57f1) despite several hours passing and a close/reopen of the PR; pushing an empty commit to force a fresh synchronize event. From ee29122f1e760118060ed3a10a2520c4bbb35440 Mon Sep 17 00:00:00 2001 From: Mark Probst Date: Tue, 21 Jul 2026 12:19:54 -0400 Subject: [PATCH 5/5] test(haskell): verify enum-case naming with a unit test instead of a grep hack The enum-case naming from issue #2868 was checked by a filename-matching branch in the Haskell fixture's runCommand that grepped the generated QuickType.hs for `= ErrorHealth`. That approach was both a special-case hack and, since haskell-enum-forbidden.schema is skipped for the Haskell fixture via skipsEnumValueValidation (the driver reports decode failures as "null" and exit 0, so its fail sample can't be detected), dead code that never ran. Replace it with a unit test that renders the schema to Haskell and asserts the generated constructors are `OkHealth`/`ErrorHealth` rather than the over-renamed `HealthErrorHealth`. A round-trip fixture cannot express this: the constructor name is invisible to JSON serialization, so correct and over-renamed output round-trip identically. The test fails against the pre-fix renderer and passes against the fix. Co-Authored-By: Claude --- test/languages.ts | 6 +- test/unit/haskell-enum-case-naming.test.ts | 75 ++++++++++++++++++++++ 2 files changed, 76 insertions(+), 5 deletions(-) create mode 100644 test/unit/haskell-enum-case-naming.test.ts diff --git a/test/languages.ts b/test/languages.ts index 6048883932..1bbe830934 100644 --- a/test/languages.ts +++ b/test/languages.ts @@ -1817,11 +1817,7 @@ export const HaskellLanguage: Language = { setupCommand: "stack install", compileCommand: "true", runCommand(sample: string) { - // Round-tripping cannot distinguish generated constructor names. - const sourceCheck = sample.endsWith("haskell-enum-forbidden.1.json") - ? "grep -q '^ = ErrorHealth$' QuickType.hs && " - : ""; - return `${sourceCheck}stack run haskell -- "${sample}"`; + return `stack run haskell -- "${sample}"`; }, diffViaSchema: true, skipDiffViaSchema: [ diff --git a/test/unit/haskell-enum-case-naming.test.ts b/test/unit/haskell-enum-case-naming.test.ts new file mode 100644 index 0000000000..72354e7627 --- /dev/null +++ b/test/unit/haskell-enum-case-naming.test.ts @@ -0,0 +1,75 @@ +import { + InputData, + JSONSchemaInput, + quicktype, +} from "../../packages/quicktype-core/src/index.js"; +import { describe, expect, test } from "vitest"; + +async function renderHaskell(schema: object): Promise { + const schemaInput = new JSONSchemaInput(undefined); + await schemaInput.addSource({ + name: "TopLevel", + schema: JSON.stringify(schema), + }); + + const inputData = new InputData(); + inputData.addInput(schemaInput); + + const result = await quicktype({ + inputData, + lang: "haskell", + }); + return result.lines.join("\n"); +} + +function enumConstructors(output: string): string[] { + // Collect the constructors of the generated `data Health` declaration, + // which are emitted one per line as `= OkHealth` / `| ErrorHealth`. + const lines = output.split("\n"); + const start = lines.findIndex((line) => line.startsWith("data Health")); + if (start < 0) { + return []; + } + + const constructors: string[] = []; + for (const line of lines.slice(start + 1)) { + const match = line.match(/^\s*[=|]\s+(\S+)/); + if (match === null) { + break; + } + + constructors.push(match[1]); + } + + return constructors; +} + +describe("Haskell enum case naming", () => { + // Enum cases are emitted as `` so the enum name already + // disambiguates each constructor. When a case name would otherwise be + // renamed to avoid a forbidden identifier (here `error`), the renderer + // must not compound the enum-name suffix on top of that rename. A + // round-trip fixture cannot catch this: the constructor name is invisible + // to JSON serialization, so both the correct and the over-renamed output + // round-trip identically. See issue #2868. + test("suffixes the enum name without over-renaming forbidden cases", async () => { + const schema = { + type: "object", + properties: { + health: { + type: "string", + enum: ["ok", "error"], + }, + }, + required: ["health"], + }; + + const output = await renderHaskell(schema); + const constructors = enumConstructors(output); + + expect(constructors).toEqual(["OkHealth", "ErrorHealth"]); + // Guard against the specific regression: the "error" case being + // renamed to "HealthError" before the enum suffix is appended. + expect(output).not.toContain("HealthErrorHealth"); + }); +});