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.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" +} 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 4e2cf42083..1bbe830934 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", "nullable-optional-one-of.schema", "all-of-additional-properties-false.schema", ]; 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"); + }); +});