keiro-dsl 0.14.0.0 → 0.15.0.0

raw patch · 1050 files changed

+72570/−39876 lines, 1050 filesdep ~bytestringdep ~keiro-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, keiro-core

API changes (from Hackage documentation)

- Keiro.Dsl.AggregateType: [aggregateTypeErrorLoc] :: AggregateTypeError -> !Loc

- Keiro.Dsl.AggregateType: [aggregateTypeErrorReason] :: AggregateTypeError -> !AggregateTypeErrorReason

- Keiro.Dsl.AggregateType: [aggregateTypeErrorUseSite] :: AggregateTypeError -> !AggregateUseSite

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordAggregate] :: BehaviorRecordRow -> !Name

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordCommand] :: BehaviorRecordRow -> !Name

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordEvidence] :: BehaviorRecordRow -> !EvidenceLevel

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordKey] :: BehaviorRecordRow -> !BehaviorKey

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordKind] :: BehaviorRecordRow -> !ObligationKind

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordOutputs] :: BehaviorRecordRow -> ![OutputEvidence]

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordOwner] :: BehaviorRecordRow -> !Maybe FilePath

- Keiro.Dsl.BehaviorCoverage: [behaviorRecordSource] :: BehaviorRecordRow -> !Name

- Keiro.Dsl.BehaviorCoverage: [behaviorRequirements] :: BehaviorObligationsReport -> ![BehaviorRequirement]

- Keiro.Dsl.BehaviorCoverage: [behaviorSubject] :: BehaviorObligationsReport -> !FilePath

- Keiro.Dsl.BehaviorCoverage: [behaviorWorkspaceService] :: BehaviorObligationsReport -> !Maybe Text

- Keiro.Dsl.BehaviorCoverage: [exactSourceColumn] :: BehaviorExactLocation -> !Int

- Keiro.Dsl.BehaviorCoverage: [exactSourceFile] :: BehaviorExactLocation -> !FilePath

- Keiro.Dsl.BehaviorCoverage: [exactSourceLine] :: BehaviorExactLocation -> !Int

- Keiro.Dsl.BehaviorCoverage: [requirementAggregate] :: BehaviorRequirement -> !Name

- Keiro.Dsl.BehaviorCoverage: [requirementCanonical] :: BehaviorRequirement -> !Text

- Keiro.Dsl.BehaviorCoverage: [requirementCommand] :: BehaviorRequirement -> !Name

- Keiro.Dsl.BehaviorCoverage: [requirementContext] :: BehaviorRequirement -> !Name

- Keiro.Dsl.BehaviorCoverage: [requirementDomainOutcome] :: BehaviorRequirement -> !Maybe TransitionOutcome

- Keiro.Dsl.BehaviorCoverage: [requirementEvents] :: BehaviorRequirement -> ![Name]

- Keiro.Dsl.BehaviorCoverage: [requirementEvidence] :: BehaviorRequirement -> !EvidenceLevel

- Keiro.Dsl.BehaviorCoverage: [requirementExactLocation] :: BehaviorRequirement -> !Maybe BehaviorExactLocation

- Keiro.Dsl.BehaviorCoverage: [requirementGuardCoverage] :: BehaviorRequirement -> !GuardCoverage

- Keiro.Dsl.BehaviorCoverage: [requirementKey] :: BehaviorRequirement -> !BehaviorKey

- Keiro.Dsl.BehaviorCoverage: [requirementKind] :: BehaviorRequirement -> !ObligationKind

- Keiro.Dsl.BehaviorCoverage: [requirementLocation] :: BehaviorRequirement -> !Loc

- Keiro.Dsl.BehaviorCoverage: [requirementMode] :: BehaviorRequirement -> !Maybe TransitionMode

- Keiro.Dsl.BehaviorCoverage: [requirementOrigin] :: BehaviorRequirement -> !RequirementOrigin

- Keiro.Dsl.BehaviorCoverage: [requirementOutputs] :: BehaviorRequirement -> ![OutputEvidence]

- Keiro.Dsl.BehaviorCoverage: [requirementOwner] :: BehaviorRequirement -> !Maybe FilePath

- Keiro.Dsl.BehaviorCoverage: [requirementSource] :: BehaviorRequirement -> !Name

- Keiro.Dsl.BehaviorCoverage: [requirementTarget] :: BehaviorRequirement -> !Maybe Name

- Keiro.Dsl.BehaviorSourceMap: [behaviorSourceColumn] :: BehaviorSourceEntry -> !Int

- Keiro.Dsl.BehaviorSourceMap: [behaviorSourceFile] :: BehaviorSourceEntry -> !FilePath

- Keiro.Dsl.BehaviorSourceMap: [behaviorSourceKey] :: BehaviorSourceEntry -> !BehaviorKey

- Keiro.Dsl.BehaviorSourceMap: [behaviorSourceLine] :: BehaviorSourceEntry -> !Int

- Keiro.Dsl.BehaviorSourceMap: [failureAggregate] :: BehaviorSourceFailure -> !Text

- Keiro.Dsl.BehaviorSourceMap: [failureCode] :: BehaviorSourceFailure -> !BehaviorSourceFailureCode

- Keiro.Dsl.BehaviorSourceMap: [failureCommand] :: BehaviorSourceFailure -> !Text

- Keiro.Dsl.BehaviorSourceMap: [failureKey] :: BehaviorSourceFailure -> !BehaviorKey

- Keiro.Dsl.BehaviorSourceMap: [failureMessage] :: BehaviorSourceFailure -> !Text

- Keiro.Dsl.BehaviorSourceMap: [failureOrigin] :: BehaviorSourceFailure -> !RequirementOrigin

- Keiro.Dsl.BehaviorSourceMap: [failureSourceSubject] :: BehaviorSourceFailure -> !SourceSubject

- Keiro.Dsl.BehaviorSourceMap: [failureSpan] :: BehaviorSourceFailure -> !Maybe SourceSpan

- Keiro.Dsl.BehaviorSourceMap: [failureState] :: BehaviorSourceFailure -> !Text

- Keiro.Dsl.CheckReport: [entryCode] :: CheckReportEntry -> !DiagnosticCode

- Keiro.Dsl.CheckReport: [entryDenied] :: CheckReportEntry -> !Bool

- Keiro.Dsl.CheckReport: [entryFile] :: CheckReportEntry -> !FilePath

- Keiro.Dsl.CheckReport: [entryLine] :: CheckReportEntry -> !Int

- Keiro.Dsl.CheckReport: [entryMessage] :: CheckReportEntry -> !Text

- Keiro.Dsl.CheckReport: [entryRelated] :: CheckReportEntry -> ![CheckReportRelated]

- Keiro.Dsl.CheckReport: [entrySeverity] :: CheckReportEntry -> !Severity

- Keiro.Dsl.CheckReport: [memberDeclaredLanguageVersion] :: CheckReportMember -> !Maybe LanguageVersion

- Keiro.Dsl.CheckReport: [memberPath] :: CheckReportMember -> !FilePath

- Keiro.Dsl.CheckReport: [memberSourceForm] :: CheckReportMember -> !Text

- Keiro.Dsl.CheckReport: [relatedFile] :: CheckReportRelated -> !FilePath

- Keiro.Dsl.CheckReport: [relatedLine] :: CheckReportRelated -> !Int

- Keiro.Dsl.CheckReport: [relatedNote] :: CheckReportRelated -> !Text

- Keiro.Dsl.CheckReport: [reportDeclaredLanguageVersion] :: CheckReportLanguage -> !Maybe LanguageVersion

- Keiro.Dsl.CheckReport: [reportDenyCodes] :: CheckReportEnforcement -> ![DiagnosticCode]

- Keiro.Dsl.CheckReport: [reportDenyWarnings] :: CheckReportEnforcement -> !Bool

- Keiro.Dsl.CheckReport: [reportEffectiveLanguageVersion] :: CheckReportLanguage -> !LanguageVersion

- Keiro.Dsl.CheckReport: [reportLanguageSupport] :: CheckReportLanguage -> !LanguageSupport

- Keiro.Dsl.CheckReport: [reportMinLanguage] :: CheckReportEnforcement -> !Maybe LanguageVersion

- Keiro.Dsl.CheckReport: [reportRuntimeSemantics] :: CheckReportLanguage -> !Text

- Keiro.Dsl.CheckReport: [reportSourceForm] :: CheckReportLanguage -> !Text

- Keiro.Dsl.CheckReport: [reportStable] :: CheckReportLanguage -> !Bool

- Keiro.Dsl.CheckReport: [summaryDeniedWarnings] :: CheckReportSummary -> !Int

- Keiro.Dsl.CheckReport: [summaryErrors] :: CheckReportSummary -> !Int

- Keiro.Dsl.CheckReport: [summaryWarnings] :: CheckReportSummary -> !Int

- Keiro.Dsl.CodecCompare: [baPayloadSchema] :: BranchArm -> !Maybe BranchSchema

- Keiro.Dsl.CodecCompare: [baWireTag] :: BranchArm -> !Text

- Keiro.Dsl.CodecCompare: [bfPresenceOptional] :: BranchField -> !Bool

- Keiro.Dsl.CodecCompare: [bfSchema] :: BranchField -> !BranchSchema

- Keiro.Dsl.CodecCompare: [bfWireKey] :: BranchField -> !Text

- Keiro.Dsl.CodecCompare: [cgKind] :: CoverageGap -> !BranchKind

- Keiro.Dsl.CodecCompare: [cgOrigin] :: CoverageGap -> !FixtureOrigin

- Keiro.Dsl.CodecCompare: [cgPointer] :: CoverageGap -> !JsonPointer

- Keiro.Dsl.CodecCompare: [classifiedName] :: ClassifiedObservation -> !Text

- Keiro.Dsl.CodecCompare: [classifiedOrigin] :: ClassifiedObservation -> !FixtureOrigin

- Keiro.Dsl.CodecCompare: [classifiedVerdict] :: ClassifiedObservation -> !FixtureVerdict

- Keiro.Dsl.CodecCompare: [coCaseName] :: CompareObservation -> !Text

- Keiro.Dsl.CodecCompare: [coFixturePath] :: CompareObservation -> !FilePath

- Keiro.Dsl.CodecCompare: [coGeneratedDecode] :: CompareObservation -> !DecodeOutcome

- Keiro.Dsl.CodecCompare: [coGeneratedValue] :: CompareObservation -> !Value

- Keiro.Dsl.CodecCompare: [coHistoricalDecode] :: CompareObservation -> !DecodeOutcome

- Keiro.Dsl.CodecCompare: [coHistoricalValue] :: CompareObservation -> !Value

- Keiro.Dsl.CodecCompare: [coInputValue] :: CompareObservation -> !Value

- Keiro.Dsl.CodecCompare: [cpBindingSymbol] :: CompareProvenance -> !QualifiedValueName

- Keiro.Dsl.CodecCompare: [cpBindingVersion] :: CompareProvenance -> !BindingVersion

- Keiro.Dsl.CodecCompare: [cpCanonicalType] :: CompareProvenance -> !CanonicalTypeId

- Keiro.Dsl.CodecCompare: [cpHistoricalCodecIdentity] :: CompareProvenance -> !Text

- Keiro.Dsl.CodecCompare: [cpHistoricalCodecVersion] :: CompareProvenance -> !Text

- Keiro.Dsl.CodecCompare: [cpWireFingerprint] :: CompareProvenance -> !Text

- Keiro.Dsl.CodecCompare: [crAuthority] :: CompareReport -> !Text

- Keiro.Dsl.CodecCompare: [crCoverageGaps] :: CompareReport -> ![CoverageGap]

- Keiro.Dsl.CodecCompare: [crInputIssues] :: CompareReport -> ![CompareInputIssue]

- Keiro.Dsl.CodecCompare: [crObservations] :: CompareReport -> ![ClassifiedObservation]

- Keiro.Dsl.CodecCompare: [crProvenance] :: CompareReport -> !CompareProvenance

- Keiro.Dsl.CodecCompare: [dbKind] :: DeclaredBranch -> !BranchKind

- Keiro.Dsl.CodecCompare: [dbOrigin] :: DeclaredBranch -> !FixtureOrigin

- Keiro.Dsl.CodecCompare: [dbPointer] :: DeclaredBranch -> !JsonPointer

- Keiro.Dsl.CodecCompare: [hcDecode] :: HistoricalCodec a -> !Value -> Either Text a

- Keiro.Dsl.CodecCompare: [hcEncode] :: HistoricalCodec a -> !a -> Value

- Keiro.Dsl.CodecCompare: [hcIdentity] :: HistoricalCodec a -> !Text

- Keiro.Dsl.CodecCompare: [hcVersion] :: HistoricalCodec a -> !Text

- Keiro.Dsl.CodecCompare: [obKind] :: ObservedBranch -> !BranchKind

- Keiro.Dsl.CodecCompare: [obOrigin] :: ObservedBranch -> !FixtureOrigin

- Keiro.Dsl.CodecCompare: [obPointer] :: ObservedBranch -> !JsonPointer

- Keiro.Dsl.CodecCompare: [reportWriteMessage] :: ReportWriteError -> !Text

- Keiro.Dsl.CodecCompare: [reportWritePath] :: ReportWriteError -> !FilePath

- Keiro.Dsl.ConformancePackage: [conformanceFileKind] :: ConformanceFile -> !ModuleKind

- Keiro.Dsl.ConformancePackage: [conformanceFilePath] :: ConformanceFile -> !FilePath

- Keiro.Dsl.ConformancePackage: [conformanceFileText] :: ConformanceFile -> !Text

- Keiro.Dsl.ConformancePackage: [conformanceReportDispositions] :: ConformancePackageReport -> ![(ConformanceFile, ConformanceWriteDisposition)]

- Keiro.Dsl.ConformancePackage: [conformanceReportPlan] :: ConformancePackageReport -> !ConformancePackagePlan

- Keiro.Dsl.ConformancePackage: [conformanceReportRoot] :: ConformancePackageReport -> !FilePath

- Keiro.Dsl.ConformancePackage: [conformanceReportStale] :: ConformancePackageReport -> ![ConformanceStaleFile]

- Keiro.Dsl.ConformancePackage: [conformanceStaleBannerPresent] :: ConformanceStaleFile -> !Maybe Bool

- Keiro.Dsl.ConformancePackage: [conformanceStaleKind] :: ConformanceStaleFile -> !ModuleKind

- Keiro.Dsl.ConformancePackage: [conformanceStalePath] :: ConformanceStaleFile -> !FilePath

- Keiro.Dsl.ConformancePackage: [cppDirectory] :: ConformancePackagePlan -> !FilePath

- Keiro.Dsl.ConformancePackage: [cppFacadeModule] :: ConformancePackagePlan -> !Text

- Keiro.Dsl.ConformancePackage: [cppFiles] :: ConformancePackagePlan -> ![ConformanceFile]

- Keiro.Dsl.ConformancePackage: [cppPackageName] :: ConformancePackagePlan -> !Text

- Keiro.Dsl.ConformancePackage: [cppRuntimePackage] :: ConformancePackagePlan -> !RuntimePackageName

- Keiro.Dsl.ConformancePackage: [cppServiceKey] :: ConformancePackagePlan -> !ConformanceServiceKey

- Keiro.Dsl.ConformancePackage: [cprFacadeModule] :: ConformancePackageRecord -> !Text

- Keiro.Dsl.ConformancePackage: [cprFiles] :: ConformancePackageRecord -> ![(ModuleKind, FilePath)]

- Keiro.Dsl.ConformancePackage: [cprRuntimePackage] :: ConformancePackageRecord -> !RuntimePackageName

- Keiro.Dsl.ConformancePackage: [cprSchema] :: ConformancePackageRecord -> !Int

- Keiro.Dsl.ConformancePackage: [cprServiceKey] :: ConformancePackageRecord -> !ConformanceServiceKey

- Keiro.Dsl.ConformancePackage: [duplicateFactKey] :: DuplicateFactKey -> !String

- Keiro.Dsl.ConformancePackage: [duplicateFactSide] :: DuplicateFactKey -> !ConformanceFactSide

- Keiro.Dsl.CoordinationImpact: [coordinationReason] :: CoordinationImpact -> !CoordinationReason

- Keiro.Dsl.CoordinationImpact: [coordinationRouter] :: CoordinationImpact -> !Name

- Keiro.Dsl.CoordinationImpact: [coordinationSeverity] :: CoordinationImpact -> !CoordinationSeverity

- Keiro.Dsl.CoordinationImpact: [driftCurrentSelection] :: RouterSelectionDrift -> !Maybe RouterSelectionSnapshot

- Keiro.Dsl.CoordinationImpact: [driftPreviousSelection] :: RouterSelectionDrift -> !Maybe RouterSelectionSnapshot

- Keiro.Dsl.CoordinationImpact: [driftRouter] :: RouterSelectionDrift -> !Name

- Keiro.Dsl.CoordinationImpact: [selectionFingerprint] :: RouterSelectionSnapshot -> !Maybe Text

- Keiro.Dsl.CoordinationImpact: [selectionIdentity] :: RouterSelectionSnapshot -> !Maybe Text

- Keiro.Dsl.CoordinationImpact: [selectionRouter] :: RouterSelectionSnapshot -> !Name

- Keiro.Dsl.CoordinationImpact: [selectionVerification] :: RouterSelectionSnapshot -> !SelectionVerification

- Keiro.Dsl.CoordinationImpact: [selectionVersion] :: RouterSelectionSnapshot -> !Maybe Natural

- Keiro.Dsl.Coverage: [coverageDelta] :: CoverageReport -> !Maybe CoverageDelta

- Keiro.Dsl.Coverage: [coverageFindings] :: CoverageReport -> ![CoverageFinding]

- Keiro.Dsl.Coverage: [coverageJsonBoundaries] :: CoverageReport -> ![JsonBoundary]

- Keiro.Dsl.Coverage: [coverageOpaqueBoundaries] :: CoverageReport -> ![OpaqueBoundary]

- Keiro.Dsl.Coverage: [coveragePrevious] :: CoverageReport -> !Maybe CoveragePrevious

- Keiro.Dsl.Coverage: [coverageRoots] :: CoverageReport -> ![CoverageRoot]

- Keiro.Dsl.Coverage: [coverageSnapshotBoundaries] :: CoverageReport -> ![SnapshotBoundary]

- Keiro.Dsl.Coverage: [coverageSpec] :: CoverageReport -> !FilePath

- Keiro.Dsl.Coverage: [coverageStructuralBoundaries] :: CoverageReport -> ![StructuralBoundary]

- Keiro.Dsl.Coverage: [coverageSummary] :: CoverageReport -> !CoverageSummary

- Keiro.Dsl.Coverage: [coverageUnsupportedSurfaces] :: CoverageReport -> ![UnsupportedSurface]

- Keiro.Dsl.Coverage: [findingCode] :: CoverageFinding -> !DiagnosticCode

- Keiro.Dsl.Coverage: [findingMessage] :: CoverageFinding -> !Text

- Keiro.Dsl.Coverage: [findingRoots] :: CoverageFinding -> ![Text]

- Keiro.Dsl.Coverage: [findingSeverity] :: CoverageFinding -> !Severity

- Keiro.Dsl.Coverage: [jsonPath] :: JsonBoundary -> !Text

- Keiro.Dsl.Coverage: [jsonRoot] :: JsonBoundary -> !Text

- Keiro.Dsl.Coverage: [jsonSurface] :: JsonBoundary -> !CoverageSurface

- Keiro.Dsl.Coverage: [opaqueCodecIdentity] :: OpaqueBoundary -> !Text

- Keiro.Dsl.Coverage: [opaqueCodecVersion] :: OpaqueBoundary -> !Text

- Keiro.Dsl.Coverage: [opaqueMappedType] :: OpaqueBoundary -> !Text

- Keiro.Dsl.Coverage: [opaquePath] :: OpaqueBoundary -> !Text

- Keiro.Dsl.Coverage: [opaqueRoot] :: OpaqueBoundary -> !Text

- Keiro.Dsl.Coverage: [previousOpaqueBoundaries] :: CoveragePrevious -> ![OpaqueBoundary]

- Keiro.Dsl.Coverage: [previousReference] :: CoveragePrevious -> !Text

- Keiro.Dsl.Coverage: [previousSummary] :: CoveragePrevious -> !CoverageSummary

- Keiro.Dsl.Coverage: [rootCanonicalType] :: CoverageRoot -> !Maybe Text

- Keiro.Dsl.Coverage: [rootCodecIdentity] :: CoverageRoot -> !Maybe Text

- Keiro.Dsl.Coverage: [rootCodecVersion] :: CoverageRoot -> !Maybe Text

- Keiro.Dsl.Coverage: [rootConsumer] :: CoverageRoot -> !Text

- Keiro.Dsl.Coverage: [rootMappedType] :: CoverageRoot -> !Text

- Keiro.Dsl.Coverage: [rootMode] :: CoverageRoot -> !CoverageMode

- Keiro.Dsl.Coverage: [rootPath] :: CoverageRoot -> !Text

- Keiro.Dsl.Coverage: [rootSurface] :: CoverageRoot -> !CoverageSurface

- Keiro.Dsl.Coverage: [rootWireFingerprint] :: CoverageRoot -> !Text

- Keiro.Dsl.Coverage: [snapshotAggregate] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotEnabled] :: SnapshotBoundary -> !Bool

- Keiro.Dsl.Coverage: [snapshotEncoding] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotInvalidation] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotMappedType] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotMode] :: SnapshotBoundary -> !CoverageMode

- Keiro.Dsl.Coverage: [snapshotRegister] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotRoot] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [snapshotWireFingerprint] :: SnapshotBoundary -> !Text

- Keiro.Dsl.Coverage: [structuralCanonicalType] :: StructuralBoundary -> !Text

- Keiro.Dsl.Coverage: [structuralMappedType] :: StructuralBoundary -> !Text

- Keiro.Dsl.Coverage: [structuralPath] :: StructuralBoundary -> !Text

- Keiro.Dsl.Coverage: [structuralRoot] :: StructuralBoundary -> !Text

- Keiro.Dsl.Coverage: [structuralWireFingerprint] :: StructuralBoundary -> !Text

- Keiro.Dsl.Coverage: [unsupportedReason] :: UnsupportedSurface -> !Text

- Keiro.Dsl.Coverage: [unsupportedSupport] :: UnsupportedSurface -> !Text

- Keiro.Dsl.Coverage: [unsupportedSurface] :: UnsupportedSurface -> !Text

- Keiro.Dsl.Diff: [ckCode] :: ChangeKind -> !DiagnosticCode

- Keiro.Dsl.Diff: [ckContext] :: ChangeKind -> !ChangeContext

- Keiro.Dsl.Diff: [ckDetail] :: ChangeKind -> !Text

- Keiro.Dsl.Diff: [ckFacet] :: ChangeKind -> !Text

- Keiro.Dsl.Diff: [ckMappedConsequences] :: ChangeKind -> !Set MappedConsequence

- Keiro.Dsl.Diff: [ckMappedPersistedImpact] :: ChangeKind -> !Maybe MappedPersistedImpact

- Keiro.Dsl.Diff: [ckNode] :: ChangeKind -> !Name

- Keiro.Dsl.Diff: [ckPaths] :: ChangeKind -> ![Text]

- Keiro.Dsl.Diff: [ckSubject] :: ChangeKind -> !Text

- Keiro.Dsl.Diff: [ckVector] :: ChangeKind -> !CompatibilityVector

- Keiro.Dsl.Diff: [cvConsumerBuild] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [cvOldBinaryReadNewEvents] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [cvPersistedIdentity] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [cvPrivateHistoryRead] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [cvPublicConsumer] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [cvRollout] :: CompatibilityVector -> !Set RolloutConstraint

- Keiro.Dsl.Diff: [cvSnapshotHydration] :: CompatibilityVector -> !SurfaceVerdict

- Keiro.Dsl.Diff: [deNew] :: DiffEnv -> !Spec

- Keiro.Dsl.Diff: [deOld] :: DiffEnv -> !Spec

- Keiro.Dsl.Diff: [mappedPersistedSurface] :: MappedPersistedImpact -> !MappedPersistedSurface

- Keiro.Dsl.Diff: [mappedPersistedVerdict] :: MappedPersistedImpact -> !SurfaceVerdict

- Keiro.Dsl.Diff: [prAdded] :: Paired n -> ![n]

- Keiro.Dsl.Diff: [prMatched] :: Paired n -> ![(n, n)]

- Keiro.Dsl.Diff: [prRemoved] :: Paired n -> ![n]

- Keiro.Dsl.DiffReport: [osFile] :: OwnedSite -> !FilePath

- Keiro.Dsl.DiffReport: [osLine] :: OwnedSite -> !Int

- Keiro.Dsl.DiffReport: [wcChange] :: WorkspaceChange -> !Change

- Keiro.Dsl.DiffReport: [wcDeclarationSite] :: WorkspaceChange -> !Maybe OwnedSite

- Keiro.Dsl.DiffReport: [wcUseSites] :: WorkspaceChange -> ![(Text, Maybe OwnedSite)]

- Keiro.Dsl.DiffReport: [wmAdoptionBaseline] :: WorkspaceMeta -> !Bool

- Keiro.Dsl.DiffReport: [wmIdentity] :: WorkspaceMeta -> !Text

- Keiro.Dsl.DiffReport: [wmManifest] :: WorkspaceMeta -> !FilePath

- Keiro.Dsl.DiffReport: [wmMembersNew] :: WorkspaceMeta -> ![FilePath]

- Keiro.Dsl.DiffReport: [wmMembersOld] :: WorkspaceMeta -> ![FilePath]

- Keiro.Dsl.DiffReport: [wmSince] :: WorkspaceMeta -> !Text

- Keiro.Dsl.EventOutput: [outputFields] :: EventOutputMapping -> ![CheckedFieldCopy]

- Keiro.Dsl.EventOutput: [outputObligation] :: EventOutputMapping -> !OutputObligationKey

- Keiro.Dsl.EventOutput: [outputSourceCommand] :: EventOutputMapping -> !Name

- Keiro.Dsl.ExplainBindings: [holeKind] :: BindingHole -> !BindingObligationKind

- Keiro.Dsl.ExplainBindings: [holeMappedName] :: BindingHole -> !Name

- Keiro.Dsl.ExplainBindings: [holeModule] :: BindingHole -> !Text

- Keiro.Dsl.ExplainBindings: [holePath] :: BindingHole -> !Maybe Text

- Keiro.Dsl.ExplainBindings: [holeSignature] :: BindingHole -> !Text

- Keiro.Dsl.ExplainBindings: [holeSymbol] :: BindingHole -> !Text

- Keiro.Dsl.ExplainBindings: [obligationBindingVersion] :: BindingObligation -> !Maybe Text

- Keiro.Dsl.ExplainBindings: [obligationCanonicalType] :: BindingObligation -> !Maybe Text

- Keiro.Dsl.ExplainBindings: [obligationCategory] :: BindingObligation -> !Text

- Keiro.Dsl.ExplainBindings: [obligationEqualityContract] :: BindingObligation -> !Maybe Text

- Keiro.Dsl.ExplainBindings: [obligationIdDomainContract] :: BindingObligation -> !Maybe Text

- Keiro.Dsl.ExplainBindings: [obligationKind] :: BindingObligation -> !BindingObligationKind

- Keiro.Dsl.ExplainBindings: [obligationMappedName] :: BindingObligation -> !Name

- Keiro.Dsl.ExplainBindings: [obligationModule] :: BindingObligation -> !Text

- Keiro.Dsl.ExplainBindings: [obligationPackage] :: BindingObligation -> !Text

- Keiro.Dsl.ExplainBindings: [obligationSignature] :: BindingObligation -> !Text

- Keiro.Dsl.ExplainBindings: [obligationSymbol] :: BindingObligation -> !Text

- Keiro.Dsl.ExplainBindings: [obligationUseSites] :: BindingObligation -> ![Text]

- Keiro.Dsl.Expression: [expressionDiagnosticCode] :: ExpressionDiagnostic -> !ExpressionDiagnosticCode

- Keiro.Dsl.Expression: [expressionDiagnosticLoc] :: ExpressionDiagnostic -> !Loc

- Keiro.Dsl.Expression: [expressionDiagnosticMessage] :: ExpressionDiagnostic -> !Text

- Keiro.Dsl.Expression: [scalarProjectionFields] :: ResolvedScalarProjection -> ![Name]

- Keiro.Dsl.Expression: [scalarProjectionOwner] :: ResolvedScalarProjection -> !MappedKey

- Keiro.Dsl.Expression: [scalarProjectionPointer] :: ResolvedScalarProjection -> !Text

- Keiro.Dsl.Expression: [typedScalarLoc] :: TypedScalarExpr -> !Loc

- Keiro.Dsl.Expression: [typedScalarNode] :: TypedScalarExpr -> !TypedScalarNode

- Keiro.Dsl.Expression: [typedScalarType] :: TypedScalarExpr -> !ResolvedAggregateType

- Keiro.Dsl.Goldens: [goldenAggregate] :: GoldenPayload -> !Text

- Keiro.Dsl.Goldens: [goldenContext] :: GoldenPayload -> !Text

- Keiro.Dsl.Goldens: [goldenEvent] :: GoldenPayload -> !Text

- Keiro.Dsl.Goldens: [goldenEvidence] :: GoldenPayload -> !GoldenEvidence

- Keiro.Dsl.Goldens: [goldenJson] :: GoldenPayload -> !Text

- Keiro.Dsl.Goldens: [goldenVersion] :: GoldenPayload -> !Int

- Keiro.Dsl.Grammar: [aggCommands] :: Aggregate -> ![Command]

- Keiro.Dsl.Grammar: [aggDomainOutcomeDuplicateLocs] :: Aggregate -> ![Loc]

- Keiro.Dsl.Grammar: [aggDomainOutcomeTypes] :: Aggregate -> !Maybe DomainOutcomeTypes

- Keiro.Dsl.Grammar: [aggEvents] :: Aggregate -> ![Event]

- Keiro.Dsl.Grammar: [aggLoc] :: Aggregate -> !Loc

- Keiro.Dsl.Grammar: [aggName] :: Aggregate -> !Name

- Keiro.Dsl.Grammar: [aggProjection] :: Aggregate -> !Maybe ProjectionSpec

- Keiro.Dsl.Grammar: [aggRegs] :: Aggregate -> ![RegDecl]

- Keiro.Dsl.Grammar: [aggSnapshot] :: Aggregate -> !Maybe SnapshotSpec

- Keiro.Dsl.Grammar: [aggStates] :: Aggregate -> ![StateDecl]

- Keiro.Dsl.Grammar: [aggTransitions] :: Aggregate -> ![Transition]

- Keiro.Dsl.Grammar: [aggWire] :: Aggregate -> !Maybe WireSpec

- Keiro.Dsl.Grammar: [aggregateFieldLoc] :: AggregateField -> !Loc

- Keiro.Dsl.Grammar: [aggregateFieldName] :: AggregateField -> !Name

- Keiro.Dsl.Grammar: [aggregateFieldSelector] :: AggregateField -> !Maybe Name

- Keiro.Dsl.Grammar: [aggregateFieldType] :: AggregateField -> !Maybe TypeExpr

- Keiro.Dsl.Grammar: [aggregateFieldWireKey] :: AggregateField -> !Maybe Text

- Keiro.Dsl.Grammar: [boKind] :: BackoffSpec -> !Name

- Keiro.Dsl.Grammar: [boMax] :: BackoffSpec -> !Maybe Text

- Keiro.Dsl.Grammar: [boMultiplier] :: BackoffSpec -> !Maybe Text

- Keiro.Dsl.Grammar: [boWindow] :: BackoffSpec -> !Text

- Keiro.Dsl.Grammar: [brCrossCheck] :: BindRow -> !Bool

- Keiro.Dsl.Grammar: [brField] :: BindRow -> !Name

- Keiro.Dsl.Grammar: [brRequired] :: BindRow -> !Bool

- Keiro.Dsl.Grammar: [brSource] :: BindRow -> !WireSource

- Keiro.Dsl.Grammar: [ceFields] :: ContractEvent -> ![ContractField]

- Keiro.Dsl.Grammar: [ceName] :: ContractEvent -> !Name

- Keiro.Dsl.Grammar: [ceTopic] :: ContractEvent -> !Name

- Keiro.Dsl.Grammar: [cfLoc] :: ContractField -> !Loc

- Keiro.Dsl.Grammar: [cfName] :: ContractField -> !Name

- Keiro.Dsl.Grammar: [cfSelector] :: ContractField -> !Maybe Name

- Keiro.Dsl.Grammar: [cfType] :: ContractField -> !ContractType

- Keiro.Dsl.Grammar: [cfWireKey] :: ContractField -> !Maybe Text

- Keiro.Dsl.Grammar: [cmdFields] :: Command -> ![AggregateField]

- Keiro.Dsl.Grammar: [cmdLoc] :: Command -> !Loc

- Keiro.Dsl.Grammar: [cmdName] :: Command -> !Name

- Keiro.Dsl.Grammar: [corrField] :: CorrelateDecl -> !Name

- Keiro.Dsl.Grammar: [corrVia] :: CorrelateDecl -> !Name

- Keiro.Dsl.Grammar: [ctrDiscriminator] :: ContractNode -> !Name

- Keiro.Dsl.Grammar: [ctrEvents] :: ContractNode -> ![ContractEvent]

- Keiro.Dsl.Grammar: [ctrLoc] :: ContractNode -> !Loc

- Keiro.Dsl.Grammar: [ctrName] :: ContractNode -> !Name

- Keiro.Dsl.Grammar: [ctrSchemaVersion] :: ContractNode -> !Int

- Keiro.Dsl.Grammar: [ctrTopics] :: ContractNode -> ![(Name, Text)]

- Keiro.Dsl.Grammar: [decBodySchemaVersion] :: DecodeSpec -> !Int

- Keiro.Dsl.Grammar: [decBodyStrict] :: DecodeSpec -> !Bool

- Keiro.Dsl.Grammar: [decEnvelope] :: DecodeSpec -> !Text

- Keiro.Dsl.Grammar: [dispCommand] :: DispatchNode -> !Name

- Keiro.Dsl.Grammar: [dispDisposition] :: DispatchNode -> !DispatchDisposition

- Keiro.Dsl.Grammar: [dispFields] :: DispatchNode -> ![FieldBinding]

- Keiro.Dsl.Grammar: [dispKey] :: DispatchNode -> !Text

- Keiro.Dsl.Grammar: [dispLoc] :: DispatchNode -> !Loc

- Keiro.Dsl.Grammar: [dispTarget] :: DispatchNode -> !Name

- Keiro.Dsl.Grammar: [drAction] :: DispositionRow -> !InboxAction

- Keiro.Dsl.Grammar: [drLoc] :: DispositionRow -> !Loc

- Keiro.Dsl.Grammar: [drOutcome] :: DispositionRow -> !Name

- Keiro.Dsl.Grammar: [emContract] :: EmitNode -> !Name

- Keiro.Dsl.Grammar: [emDiscriminant] :: EmitNode -> !Name

- Keiro.Dsl.Grammar: [emIdempotencyKey] :: EmitNode -> !DeriveSpec

- Keiro.Dsl.Grammar: [emKey] :: EmitNode -> !Name

- Keiro.Dsl.Grammar: [emLoc] :: EmitNode -> !Loc

- Keiro.Dsl.Grammar: [emMap] :: EmitNode -> ![EmitMapRow]

- Keiro.Dsl.Grammar: [emMessageId] :: EmitNode -> !DeriveSpec

- Keiro.Dsl.Grammar: [emName] :: EmitNode -> !Name

- Keiro.Dsl.Grammar: [emSkip] :: EmitNode -> !Bool

- Keiro.Dsl.Grammar: [emSource] :: EmitNode -> !Text

- Keiro.Dsl.Grammar: [emTopic] :: EmitNode -> !Name

- Keiro.Dsl.Grammar: [emrEvent] :: EmitMapRow -> !Name

- Keiro.Dsl.Grammar: [emrLoc] :: EmitMapRow -> !Loc

- Keiro.Dsl.Grammar: [emrValue] :: EmitMapRow -> !Text

- Keiro.Dsl.Grammar: [enumBinding] :: EnumDecl -> !Maybe NominalBindingDecl

- Keiro.Dsl.Grammar: [enumCtors] :: EnumDecl -> ![(Name, Text)]

- Keiro.Dsl.Grammar: [enumLoc] :: EnumDecl -> !Loc

- Keiro.Dsl.Grammar: [enumName] :: EnumDecl -> !Name

- Keiro.Dsl.Grammar: [erCompatibleRevisions] :: ExternalReadNode -> ![Name]

- Keiro.Dsl.Grammar: [erLoc] :: ExternalReadNode -> !Loc

- Keiro.Dsl.Grammar: [erName] :: ExternalReadNode -> !Name

- Keiro.Dsl.Grammar: [erQueryModel] :: ExternalReadNode -> !Name

- Keiro.Dsl.Grammar: [erResultSchema] :: ExternalReadNode -> !Text

- Keiro.Dsl.Grammar: [erResultType] :: ExternalReadNode -> !Text

- Keiro.Dsl.Grammar: [erSurfaceGeneration] :: ExternalReadNode -> !Int

- Keiro.Dsl.Grammar: [erVersion] :: ExternalReadNode -> !Int

- Keiro.Dsl.Grammar: [evBody] :: Event -> !EventBody

- Keiro.Dsl.Grammar: [evDeprecated] :: Event -> !Bool

- Keiro.Dsl.Grammar: [evLoc] :: Event -> !Loc

- Keiro.Dsl.Grammar: [evName] :: Event -> !Name

- Keiro.Dsl.Grammar: [evRetiring] :: Event -> !Bool

- Keiro.Dsl.Grammar: [evUpcastFrom] :: Event -> !Maybe (Int, Hole)

- Keiro.Dsl.Grammar: [evVersion] :: Event -> !Int

- Keiro.Dsl.Grammar: [faField] :: FireAtExpr -> !Name

- Keiro.Dsl.Grammar: [faWindow] :: FireAtExpr -> !Text

- Keiro.Dsl.Grammar: [fbName] :: FieldBinding -> !Name

- Keiro.Dsl.Grammar: [fbValue] :: FieldBinding -> !Maybe Text

- Keiro.Dsl.Grammar: [fieldName] :: Field -> !Name

- Keiro.Dsl.Grammar: [fieldType] :: Field -> !Maybe Name

- Keiro.Dsl.Grammar: [fireCommand] :: FireNode -> !Name

- Keiro.Dsl.Grammar: [fireDisposition] :: FireNode -> !FireDisposition

- Keiro.Dsl.Grammar: [fireFields] :: FireNode -> ![FieldBinding]

- Keiro.Dsl.Grammar: [fireFiredEventId] :: FireNode -> !IdExpr

- Keiro.Dsl.Grammar: [fireKey] :: FireNode -> !Text

- Keiro.Dsl.Grammar: [fireTarget] :: FireNode -> !Name

- Keiro.Dsl.Grammar: [gkField] :: WqGroupKey -> !Name

- Keiro.Dsl.Grammar: [gkFixture] :: WqGroupKey -> !Maybe Text

- Keiro.Dsl.Grammar: [gkVia] :: WqGroupKey -> !Name

- Keiro.Dsl.Grammar: [hAdvance] :: HandleNode -> !AdvanceNode

- Keiro.Dsl.Grammar: [hDispatch] :: HandleNode -> ![DispatchNode]

- Keiro.Dsl.Grammar: [hOn] :: HandleNode -> !Name

- Keiro.Dsl.Grammar: [hSchedule] :: HandleNode -> !Name

- Keiro.Dsl.Grammar: [hsModule] :: HaskellSource -> !Text

- Keiro.Dsl.Grammar: [hsPackage] :: HaskellSource -> !Text

- Keiro.Dsl.Grammar: [hsType] :: HaskellSource -> !Name

- Keiro.Dsl.Grammar: [idBinding] :: IdDecl -> !Maybe NominalBindingDecl

- Keiro.Dsl.Grammar: [idLoc] :: IdDecl -> !Loc

- Keiro.Dsl.Grammar: [idName] :: IdDecl -> !Name

- Keiro.Dsl.Grammar: [idPrefix] :: IdDecl -> !Text

- Keiro.Dsl.Grammar: [ideField] :: IdExpr -> !Name

- Keiro.Dsl.Grammar: [idePrefix] :: IdExpr -> !Text

- Keiro.Dsl.Grammar: [ideStrategy] :: IdExpr -> !IdStrategy

- Keiro.Dsl.Grammar: [inFields] :: InputDecl -> ![Field]

- Keiro.Dsl.Grammar: [inLoc] :: InputDecl -> !Loc

- Keiro.Dsl.Grammar: [inName] :: InputDecl -> !Name

- Keiro.Dsl.Grammar: [inType] :: InputDecl -> !Maybe TypeExpr

- Keiro.Dsl.Grammar: [inkAccept] :: IntakeNode -> ![Name]

- Keiro.Dsl.Grammar: [inkBinds] :: IntakeNode -> ![BindRow]

- Keiro.Dsl.Grammar: [inkContract] :: IntakeNode -> !Name

- Keiro.Dsl.Grammar: [inkDecode] :: IntakeNode -> !DecodeSpec

- Keiro.Dsl.Grammar: [inkDedupeKey] :: IntakeNode -> !Name

- Keiro.Dsl.Grammar: [inkDedupePolicy] :: IntakeNode -> !Name

- Keiro.Dsl.Grammar: [inkDisposition] :: IntakeNode -> ![DispositionRow]

- Keiro.Dsl.Grammar: [inkLoc] :: IntakeNode -> !Loc

- Keiro.Dsl.Grammar: [inkName] :: IntakeNode -> !Name

- Keiro.Dsl.Grammar: [inkPersist] :: IntakeNode -> !InkPersist

- Keiro.Dsl.Grammar: [inkTopic] :: IntakeNode -> !Name

- Keiro.Dsl.Grammar: [mapPairs] :: Mapping -> ![(Name, Name)]

- Keiro.Dsl.Grammar: [mapPartial] :: Mapping -> !Bool

- Keiro.Dsl.Grammar: [nominalBindingVersion] :: NominalBindingDecl -> !Maybe Text

- Keiro.Dsl.Grammar: [nominalBinding] :: NominalBindingDecl -> !Maybe Text

- Keiro.Dsl.Grammar: [nominalCanonicalType] :: NominalBindingDecl -> !Maybe Text

- Keiro.Dsl.Grammar: [nominalFixtures] :: NominalBindingDecl -> !Maybe Text

- Keiro.Dsl.Grammar: [nominalHaskell] :: NominalBindingDecl -> !Maybe HaskellSource

- Keiro.Dsl.Grammar: [nominalInitial] :: NominalBindingDecl -> !Maybe Text

- Keiro.Dsl.Grammar: [nominalLoc] :: NominalBindingDecl -> !Loc

- Keiro.Dsl.Grammar: [nominalScalarBinding] :: NominalScalarDecl -> !NominalBindingDecl

- Keiro.Dsl.Grammar: [nominalScalarLoc] :: NominalScalarDecl -> !Loc

- Keiro.Dsl.Grammar: [nominalScalarName] :: NominalScalarDecl -> !Name

- Keiro.Dsl.Grammar: [nominalScalarRepresentation] :: NominalScalarDecl -> !Name

- Keiro.Dsl.Grammar: [opLoc] :: OperationNode -> !Loc

- Keiro.Dsl.Grammar: [opName] :: OperationNode -> !Name

- Keiro.Dsl.Grammar: [opShape] :: OperationNode -> !OperationShape

- Keiro.Dsl.Grammar: [pdDedupKey] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdDedupQueueField] :: PgmqDispatchNode -> !Text

- Keiro.Dsl.Grammar: [pdDedupQueue] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdDedupReadModelField] :: PgmqDispatchNode -> !Text

- Keiro.Dsl.Grammar: [pdDedupReadModel] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdEnqueueTo] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdFanoutBody] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdLoc] :: PgmqDispatchNode -> !Loc

- Keiro.Dsl.Grammar: [pdName] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdSourceKey] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [pdSourceReadModel] :: PgmqDispatchNode -> !Name

- Keiro.Dsl.Grammar: [poCheckpointOnMissing] :: ProjectionOwnerNode -> ![CheckpointOnMissingNode]

- Keiro.Dsl.Grammar: [poDedup] :: ProjectionOwnerNode -> !Maybe Text

- Keiro.Dsl.Grammar: [poDelivery] :: ProjectionOwnerNode -> !ProjectionDelivery

- Keiro.Dsl.Grammar: [poGroup] :: ProjectionOwnerNode -> !Name

- Keiro.Dsl.Grammar: [poLoc] :: ProjectionOwnerNode -> !Loc

- Keiro.Dsl.Grammar: [poName] :: ProjectionOwnerNode -> !Name

- Keiro.Dsl.Grammar: [poOrder] :: ProjectionOwnerNode -> !Int

- Keiro.Dsl.Grammar: [poReplay] :: ProjectionOwnerNode -> !ProjectionReplayPolicy

- Keiro.Dsl.Grammar: [poSources] :: ProjectionOwnerNode -> ![CatalogSource]

- Keiro.Dsl.Grammar: [poSubscription] :: ProjectionOwnerNode -> !Maybe Text

- Keiro.Dsl.Grammar: [poTargets] :: ProjectionOwnerNode -> ![Name]

- Keiro.Dsl.Grammar: [procCorrelate] :: ProcessNode -> !CorrelateDecl

- Keiro.Dsl.Grammar: [procHandle] :: ProcessNode -> !HandleNode

- Keiro.Dsl.Grammar: [procId] :: ProcessNode -> !Name

- Keiro.Dsl.Grammar: [procInput] :: ProcessNode -> !InputDecl

- Keiro.Dsl.Grammar: [procLoc] :: ProcessNode -> !Loc

- Keiro.Dsl.Grammar: [procName] :: ProcessNode -> !Text

- Keiro.Dsl.Grammar: [procPoison] :: ProcessNode -> !PolicyChoice

- Keiro.Dsl.Grammar: [procProjections] :: ProcessNode -> ![Name]

- Keiro.Dsl.Grammar: [procRejected] :: ProcessNode -> !PolicyChoice

- Keiro.Dsl.Grammar: [procSaga] :: ProcessNode -> !SagaRef

- Keiro.Dsl.Grammar: [procTarget] :: ProcessNode -> !Name

- Keiro.Dsl.Grammar: [procTimer] :: ProcessNode -> !TimerNode

- Keiro.Dsl.Grammar: [projConsistency] :: ProjectionSpec -> !Maybe Consistency

- Keiro.Dsl.Grammar: [projKey] :: ProjectionSpec -> !Name

- Keiro.Dsl.Grammar: [projLoc] :: ProjectionSpec -> !Loc

- Keiro.Dsl.Grammar: [projStatusMap] :: ProjectionSpec -> !Maybe Mapping

- Keiro.Dsl.Grammar: [projTable] :: ProjectionSpec -> !Name

- Keiro.Dsl.Grammar: [prtExpectedShape] :: RevisionTargetNode -> !Text

- Keiro.Dsl.Grammar: [prtPromotionObjects] :: RevisionTargetNode -> ![PromotionObjectNode]

- Keiro.Dsl.Grammar: [prtProvisionerVersion] :: RevisionTargetNode -> !Int

- Keiro.Dsl.Grammar: [prtProvisioner] :: RevisionTargetNode -> !Text

- Keiro.Dsl.Grammar: [prtSchemaVersion] :: RevisionTargetNode -> !Text

- Keiro.Dsl.Grammar: [prtTarget] :: RevisionTargetNode -> !Name

- Keiro.Dsl.Grammar: [prtValidatorVersion] :: RevisionTargetNode -> !Int

- Keiro.Dsl.Grammar: [prtValidator] :: RevisionTargetNode -> !Text

- Keiro.Dsl.Grammar: [prvGroup] :: ProjectionRevisionNode -> !Name

- Keiro.Dsl.Grammar: [prvLoc] :: ProjectionRevisionNode -> !Loc

- Keiro.Dsl.Grammar: [prvName] :: ProjectionRevisionNode -> !Name

- Keiro.Dsl.Grammar: [prvTargets] :: ProjectionRevisionNode -> ![RevisionTargetNode]

- Keiro.Dsl.Grammar: [ptDependsOn] :: ProjectionTargetNode -> ![Name]

- Keiro.Dsl.Grammar: [ptLoc] :: ProjectionTargetNode -> !Loc

- Keiro.Dsl.Grammar: [ptName] :: ProjectionTargetNode -> !Name

- Keiro.Dsl.Grammar: [ptReset] :: ProjectionTargetNode -> !TargetResetPolicy

- Keiro.Dsl.Grammar: [ptSchema] :: ProjectionTargetNode -> !Text

- Keiro.Dsl.Grammar: [ptTable] :: ProjectionTargetNode -> !Text

- Keiro.Dsl.Grammar: [pubBackoff] :: PublisherNode -> !BackoffSpec

- Keiro.Dsl.Grammar: [pubEmit] :: PublisherNode -> !Name

- Keiro.Dsl.Grammar: [pubLoc] :: PublisherNode -> !Loc

- Keiro.Dsl.Grammar: [pubMaxAttempts] :: PublisherNode -> !Int

- Keiro.Dsl.Grammar: [pubName] :: PublisherNode -> !Name

- Keiro.Dsl.Grammar: [pubOrdering] :: PublisherNode -> !Name

- Keiro.Dsl.Grammar: [pubOutboxField] :: PublisherNode -> !Name

- Keiro.Dsl.Grammar: [rdCommand] :: RouterDispatchNode -> !Name

- Keiro.Dsl.Grammar: [rdDisposition] :: RouterDispatchNode -> !DispatchDisposition

- Keiro.Dsl.Grammar: [rdFields] :: RouterDispatchNode -> ![FieldBinding]

- Keiro.Dsl.Grammar: [rdLoc] :: RouterDispatchNode -> !Loc

- Keiro.Dsl.Grammar: [regInitial] :: RegDecl -> !RegInitial

- Keiro.Dsl.Grammar: [regLoc] :: RegDecl -> !Loc

- Keiro.Dsl.Grammar: [regName] :: RegDecl -> !Name

- Keiro.Dsl.Grammar: [regType] :: RegDecl -> !TypeExpr

- Keiro.Dsl.Grammar: [rgLoc] :: RebuildGroupNode -> !Loc

- Keiro.Dsl.Grammar: [rgName] :: RebuildGroupNode -> !Name

- Keiro.Dsl.Grammar: [rgOrder] :: RebuildGroupNode -> ![Name]

- Keiro.Dsl.Grammar: [rgTargets] :: RebuildGroupNode -> ![Name]

- Keiro.Dsl.Grammar: [rmBackingTarget] :: ReadModelNode -> !Maybe Name

- Keiro.Dsl.Grammar: [rmColumns] :: ReadModelNode -> ![RmColumn]

- Keiro.Dsl.Grammar: [rmFreshness] :: ReadModelNode -> !QueryFreshnessNode

- Keiro.Dsl.Grammar: [rmGroup] :: ReadModelNode -> !Maybe Name

- Keiro.Dsl.Grammar: [rmLoc] :: ReadModelNode -> !Loc

- Keiro.Dsl.Grammar: [rmName] :: ReadModelNode -> !Name

- Keiro.Dsl.Grammar: [rmObservedTargets] :: ReadModelNode -> ![Name]

- Keiro.Dsl.Grammar: [rmSchema] :: ReadModelNode -> !Text

- Keiro.Dsl.Grammar: [rmShape] :: ReadModelNode -> !Text

- Keiro.Dsl.Grammar: [rmSupply] :: ReadModelNode -> !ReadModelSupply

- Keiro.Dsl.Grammar: [rmTable] :: ReadModelNode -> !Text

- Keiro.Dsl.Grammar: [rmVersion] :: ReadModelNode -> !Int

- Keiro.Dsl.Grammar: [rpoCanonicalName] :: PromotionObjectNode -> !Text

- Keiro.Dsl.Grammar: [rpoGenerationName] :: PromotionObjectNode -> !Text

- Keiro.Dsl.Grammar: [rpoKind] :: PromotionObjectNode -> !PromotionObjectKindNode

- Keiro.Dsl.Grammar: [rsDedupeLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsDedupe] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsEmptyPolicyLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsEmptyPolicy] :: RouterSelectionDecl -> !SelectionDispositionSyntax

- Keiro.Dsl.Grammar: [rsFailurePolicyLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsFailurePolicy] :: RouterSelectionDecl -> !SelectionDispositionSyntax

- Keiro.Dsl.Grammar: [rsIdentityLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsIdentity] :: RouterSelectionDecl -> !Text

- Keiro.Dsl.Grammar: [rsLimit] :: RouterSelectionDecl -> !Maybe (Natural, Loc)

- Keiro.Dsl.Grammar: [rsLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsOrderLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsOrder] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsPartialLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsPartial] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsPredicate] :: RouterSelectionDecl -> !Expr

- Keiro.Dsl.Grammar: [rsQueryInputLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsQueryInput] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsQueryLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsQuery] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsRecipient] :: RouterSelectionDecl -> !Expr

- Keiro.Dsl.Grammar: [rsRedeliveryLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsRedelivery] :: RouterSelectionDecl -> !Name

- Keiro.Dsl.Grammar: [rsVersionLoc] :: RouterSelectionDecl -> !Loc

- Keiro.Dsl.Grammar: [rsVersion] :: RouterSelectionDecl -> !Natural

- Keiro.Dsl.Grammar: [rtDispatch] :: RouterNode -> !RouterDispatchNode

- Keiro.Dsl.Grammar: [rtId] :: RouterNode -> !Name

- Keiro.Dsl.Grammar: [rtInput] :: RouterNode -> !InputDecl

- Keiro.Dsl.Grammar: [rtKey] :: RouterNode -> !CorrelateDecl

- Keiro.Dsl.Grammar: [rtLoc] :: RouterNode -> !Loc

- Keiro.Dsl.Grammar: [rtName] :: RouterNode -> !Text

- Keiro.Dsl.Grammar: [rtPoison] :: RouterNode -> !PolicyChoice

- Keiro.Dsl.Grammar: [rtProjections] :: RouterNode -> ![Name]

- Keiro.Dsl.Grammar: [rtRejected] :: RouterNode -> !PolicyChoice

- Keiro.Dsl.Grammar: [rtResolve] :: RouterNode -> !ResolveDecl

- Keiro.Dsl.Grammar: [rtTarget] :: RouterNode -> !Name

- Keiro.Dsl.Grammar: [ruleCases] :: RuleDecl -> ![(Name, Expr)]

- Keiro.Dsl.Grammar: [ruleCodomain] :: RuleDecl -> !Name

- Keiro.Dsl.Grammar: [ruleDomain] :: RuleDecl -> !Name

- Keiro.Dsl.Grammar: [ruleLoc] :: RuleDecl -> !Loc

- Keiro.Dsl.Grammar: [ruleName] :: RuleDecl -> !Name

- Keiro.Dsl.Grammar: [rvLoc] :: ResolveDecl -> !Loc

- Keiro.Dsl.Grammar: [rvRow] :: ResolveDecl -> ![Name]

- Keiro.Dsl.Grammar: [rvSource] :: ResolveDecl -> !ResolveSource

- Keiro.Dsl.Grammar: [sagaAgg] :: SagaRef -> !Name

- Keiro.Dsl.Grammar: [sagaCategory] :: SagaRef -> !Text

- Keiro.Dsl.Grammar: [snapCodecVersion] :: SnapshotSpec -> !Int

- Keiro.Dsl.Grammar: [snapLoc] :: SnapshotSpec -> !Loc

- Keiro.Dsl.Grammar: [snapPolicy] :: SnapshotSpec -> !SnapPolicy

- Keiro.Dsl.Grammar: [snapShapeHash] :: SnapshotSpec -> !Text

- Keiro.Dsl.Grammar: [specContext] :: Spec -> !Name

- Keiro.Dsl.Grammar: [specEnums] :: Spec -> ![EnumDecl]

- Keiro.Dsl.Grammar: [specIds] :: Spec -> ![IdDecl]

- Keiro.Dsl.Grammar: [specLayout] :: Spec -> !Maybe Placement

- Keiro.Dsl.Grammar: [specMapped] :: Spec -> ![MappedDecl]

- Keiro.Dsl.Grammar: [specModuleRoot] :: Spec -> !Maybe Text

- Keiro.Dsl.Grammar: [specNodes] :: Spec -> ![Node]

- Keiro.Dsl.Grammar: [specNominalScalars] :: Spec -> ![NominalScalarDecl]

- Keiro.Dsl.Grammar: [specRules] :: Spec -> ![RuleDecl]

- Keiro.Dsl.Grammar: [stLoc] :: StateDecl -> !Loc

- Keiro.Dsl.Grammar: [stName] :: StateDecl -> !Name

- Keiro.Dsl.Grammar: [stTerminal] :: StateDecl -> !Bool

- Keiro.Dsl.Grammar: [tCommand] :: Transition -> !Name

- Keiro.Dsl.Grammar: [tEmits] :: Transition -> ![Name]

- Keiro.Dsl.Grammar: [tGoto] :: Transition -> !Name

- Keiro.Dsl.Grammar: [tGuard] :: Transition -> !Maybe Expr

- Keiro.Dsl.Grammar: [tImplementation] :: Transition -> !TransitionImplementation

- Keiro.Dsl.Grammar: [tLoc] :: Transition -> !Loc

- Keiro.Dsl.Grammar: [tMode] :: Transition -> !TransitionMode

- Keiro.Dsl.Grammar: [tOutcomeDuplicateLocs] :: Transition -> ![Loc]

- Keiro.Dsl.Grammar: [tOutcome] :: Transition -> !Maybe TransitionOutcome

- Keiro.Dsl.Grammar: [tSource] :: Transition -> !Name

- Keiro.Dsl.Grammar: [tWrites] :: Transition -> ![(Name, Expr)]

- Keiro.Dsl.Grammar: [tmDeadLetter] :: TimerNode -> !Text

- Keiro.Dsl.Grammar: [tmDecodeUnknown] :: TimerNode -> !Name

- Keiro.Dsl.Grammar: [tmFireAt] :: TimerNode -> !FireAtExpr

- Keiro.Dsl.Grammar: [tmFire] :: TimerNode -> !FireNode

- Keiro.Dsl.Grammar: [tmId] :: TimerNode -> !IdExpr

- Keiro.Dsl.Grammar: [tmLoc] :: TimerNode -> !Loc

- Keiro.Dsl.Grammar: [tmMaxAttempts] :: TimerNode -> !Int

- Keiro.Dsl.Grammar: [tmName] :: TimerNode -> !Name

- Keiro.Dsl.Grammar: [tmPayload] :: TimerNode -> ![FieldBinding]

- Keiro.Dsl.Grammar: [ueContentsField] :: UnionEncoding -> !Text

- Keiro.Dsl.Grammar: [ueTagField] :: UnionEncoding -> !Text

- Keiro.Dsl.Grammar: [ueUnknownFields] :: UnionEncoding -> !UnknownFields

- Keiro.Dsl.Grammar: [waCtor] :: WireArm -> !Name

- Keiro.Dsl.Grammar: [waLoc] :: WireArm -> !Loc

- Keiro.Dsl.Grammar: [waPayload] :: WireArm -> !Maybe TypeExpr

- Keiro.Dsl.Grammar: [waTag] :: WireArm -> !Text

- Keiro.Dsl.Grammar: [weCtor] :: WireEnum -> !Name

- Keiro.Dsl.Grammar: [weLoc] :: WireEnum -> !Loc

- Keiro.Dsl.Grammar: [weTag] :: WireEnum -> !Text

- Keiro.Dsl.Grammar: [wfBody] :: WorkflowNode -> ![WfBodyItem]

- Keiro.Dsl.Grammar: [wfHaskell] :: WireField -> !Name

- Keiro.Dsl.Grammar: [wfIdField] :: WorkflowNode -> !Maybe Name

- Keiro.Dsl.Grammar: [wfIdVia] :: WorkflowNode -> !Name

- Keiro.Dsl.Grammar: [wfId] :: WorkflowNode -> !Name

- Keiro.Dsl.Grammar: [wfInputFields] :: WorkflowNode -> ![Field]

- Keiro.Dsl.Grammar: [wfInput] :: WorkflowNode -> !Name

- Keiro.Dsl.Grammar: [wfKey] :: WireField -> !Text

- Keiro.Dsl.Grammar: [wfLoc] :: WorkflowNode -> !Loc

- Keiro.Dsl.Grammar: [wfOnMissing] :: WireField -> !Maybe OnMissing

- Keiro.Dsl.Grammar: [wfOutput] :: WorkflowNode -> !Name

- Keiro.Dsl.Grammar: [wfPresence] :: WireField -> !Presence

- Keiro.Dsl.Grammar: [wfStable] :: WorkflowNode -> !Text

- Keiro.Dsl.Grammar: [wfType] :: WireField -> !TypeExpr

- Keiro.Dsl.Grammar: [wireFields] :: WireSpec -> !Text

- Keiro.Dsl.Grammar: [wireKind] :: WireSpec -> !Text

- Keiro.Dsl.Grammar: [wireSchemaVersion] :: WireSpec -> !Int

- Keiro.Dsl.Grammar: [wqDelay] :: WorkqueueNode -> !Text

- Keiro.Dsl.Grammar: [wqDisposition] :: WorkqueueNode -> ![WqDispRow]

- Keiro.Dsl.Grammar: [wqDlqOn] :: WorkqueueNode -> !Bool

- Keiro.Dsl.Grammar: [wqDlq] :: WorkqueueNode -> !Text

- Keiro.Dsl.Grammar: [wqGroupKey] :: WorkqueueNode -> !Maybe WqGroupKey

- Keiro.Dsl.Grammar: [wqLoc] :: WorkqueueNode -> !Loc

- Keiro.Dsl.Grammar: [wqLogical] :: WorkqueueNode -> !Text

- Keiro.Dsl.Grammar: [wqMaxRetries] :: WorkqueueNode -> !Int

- Keiro.Dsl.Grammar: [wqName] :: WorkqueueNode -> !Name

- Keiro.Dsl.Grammar: [wqOrdering] :: WorkqueueNode -> !WqOrdering

- Keiro.Dsl.Grammar: [wqPayloadName] :: WorkqueueNode -> !Name

- Keiro.Dsl.Grammar: [wqPayload] :: WorkqueueNode -> ![WqField]

- Keiro.Dsl.Grammar: [wqPhysical] :: WorkqueueNode -> !Text

- Keiro.Dsl.Grammar: [wqProvision] :: WorkqueueNode -> !WqProvision

- Keiro.Dsl.Grammar: [wqTable] :: WorkqueueNode -> !Text

- Keiro.Dsl.Grammar: [wqdAction] :: WqDispRow -> !InboxAction

- Keiro.Dsl.Grammar: [wqdLoc] :: WqDispRow -> !Loc

- Keiro.Dsl.Grammar: [wqdOutcome] :: WqDispRow -> !Name

- Keiro.Dsl.Grammar: [wqfLoc] :: WqField -> !Loc

- Keiro.Dsl.Grammar: [wqfName] :: WqField -> !Name

- Keiro.Dsl.Grammar: [wqfType] :: WqField -> !QueuePayloadType

- Keiro.Dsl.Grammar: [wqfWire] :: WqField -> !Text

- Keiro.Dsl.HaskellImport: [referenceModule] :: HaskellReference -> !Text

- Keiro.Dsl.HaskellImport: [referenceName] :: HaskellReference -> !Text

- Keiro.Dsl.HaskellImport: [referenceNamespace] :: HaskellReference -> !HaskellNamespace

- Keiro.Dsl.HaskellImport: [referenceQualification] :: HaskellReference -> !QualificationPreference

- Keiro.Dsl.HaskellSourceMove: [moveBackupPath] :: SourceMove -> !FilePath

- Keiro.Dsl.HaskellSourceMove: [moveContentDigest] :: SourceMove -> !Maybe Text

- Keiro.Dsl.HaskellSourceMove: [moveKind] :: SourceMove -> !ModuleKind

- Keiro.Dsl.HaskellSourceMove: [moveNewModule] :: SourceMove -> !Text

- Keiro.Dsl.HaskellSourceMove: [moveNewPath] :: SourceMove -> !FilePath

- Keiro.Dsl.HaskellSourceMove: [moveOldModule] :: SourceMove -> !Text

- Keiro.Dsl.HaskellSourceMove: [moveOldPath] :: SourceMove -> !FilePath

- Keiro.Dsl.HaskellSourceMove: [moveRole] :: SourceMove -> !ModuleRole

- Keiro.Dsl.HaskellSourceMove: [moveTransformedDigest] :: SourceMove -> !Maybe Text

- Keiro.Dsl.LanguageVersion: [definitionBodyParser] :: LanguageDefinition -> !LanguageBodyParser

- Keiro.Dsl.LanguageVersion: [definitionMaturity] :: LanguageDefinition -> !LanguageMaturity

- Keiro.Dsl.LanguageVersion: [definitionPredecessor] :: LanguageDefinition -> !Maybe LanguageVersion

- Keiro.Dsl.LanguageVersion: [definitionRuntimeSemanticsProfile] :: LanguageDefinition -> !RuntimeSemanticsProfile

- Keiro.Dsl.LanguageVersion: [definitionSupport] :: LanguageDefinition -> !LanguageSupport

- Keiro.Dsl.LanguageVersion: [definitionSyntaxProfile] :: LanguageDefinition -> !SyntaxProfile

- Keiro.Dsl.LanguageVersion: [definitionVersion] :: LanguageDefinition -> !LanguageVersion

- Keiro.Dsl.LanguageVersion: [parsedSourceLanguage] :: ParsedSource -> !SourceLanguage

- Keiro.Dsl.LanguageVersion: [parsedSpec] :: ParsedSource -> !Spec

- Keiro.Dsl.LanguageVersion: [sourceLanguageDeclaredVersion] :: SourceLanguageDiagnostic -> !Maybe LanguageVersion

- Keiro.Dsl.LanguageVersion: [sourceLanguageErrorCode] :: SourceLanguageDiagnostic -> !SourceLanguageErrorCode

- Keiro.Dsl.LanguageVersion: [sourceLanguageLoc] :: SourceLanguageDiagnostic -> !Loc

- Keiro.Dsl.LanguageVersion: [sourceLanguageSource] :: SourceLanguageDiagnostic -> !FilePath

- Keiro.Dsl.LanguageVersion: [sourceLanguageSupportedVersions] :: SourceLanguageDiagnostic -> !NonEmpty LanguageVersion

- Keiro.Dsl.LanguageVersion: [sourceLanguageToken] :: SourceLanguageDiagnostic -> !Maybe Text

- Keiro.Dsl.MappedConsumer: [consumerMappings] :: ConsumerPlan -> ![MappingIdentity]

- Keiro.Dsl.MappedConsumer: [consumerModules] :: ConsumerPlan -> ![Text]

- Keiro.Dsl.MappedConsumer: [consumerPackages] :: ConsumerPlan -> ![Text]

- Keiro.Dsl.MappedConsumer: [mappingBindingSymbol] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingBindingVersion] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingCanonicalType] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingCodecIdentity] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingCodecVersion] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingFixtureSymbol] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingInitialSymbol] :: MappingIdentity -> !Maybe Text

- Keiro.Dsl.MappedConsumer: [mappingModule] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingNominalCategory] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingNominalRepresentation] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingPackage] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingSpecName] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedConsumer: [mappingType] :: MappingIdentity -> !Text

- Keiro.Dsl.MappedDiff: [mfCode] :: MappedFinding -> !DiagnosticCode

- Keiro.Dsl.MappedDiff: [mfDeclaration] :: MappedFinding -> !Name

- Keiro.Dsl.MappedDiff: [mfDetail] :: MappedFinding -> !Text

- Keiro.Dsl.MappedDiff: [mfLeaf] :: MappedFinding -> !Text

- Keiro.Dsl.MappedDiff: [mfOldUnknownFields] :: MappedFinding -> !Maybe UnknownFields

- Keiro.Dsl.MappedDiff: [mfUsePaths] :: MappedFinding -> ![UsePath]

- Keiro.Dsl.NominalType: [consumerNominalBindingVersion] :: ConsumerNominalBinding -> !BindingVersion

- Keiro.Dsl.NominalType: [consumerNominalBinding] :: ConsumerNominalBinding -> !QualifiedValueName

- Keiro.Dsl.NominalType: [consumerNominalCanonical] :: ConsumerNominalBinding -> !CanonicalTypeId

- Keiro.Dsl.NominalType: [consumerNominalFixtures] :: ConsumerNominalBinding -> !QualifiedValueName

- Keiro.Dsl.NominalType: [consumerNominalHaskell] :: ConsumerNominalBinding -> !HaskellSource

- Keiro.Dsl.NominalType: [consumerNominalInitial] :: ConsumerNominalBinding -> !Maybe QualifiedValueName

- Keiro.Dsl.NominalType: [equalityContractVersion] :: CheckedNominalEquality -> !Text

- Keiro.Dsl.NominalType: [equalityDomain] :: CheckedNominalEquality -> !NominalEqualityDomain

- Keiro.Dsl.NominalType: [equalityKeyRepresentation] :: CheckedNominalEquality -> !NominalEqualityKey

- Keiro.Dsl.NominalType: [resolvedNominalLoc] :: ResolvedNominalType -> !Loc

- Keiro.Dsl.NominalType: [resolvedNominalName] :: ResolvedNominalType -> !Name

- Keiro.Dsl.NominalType: [resolvedNominalOwnership] :: ResolvedNominalType -> !NominalOwnership

- Keiro.Dsl.NominalType: [resolvedNominalRepresentation] :: ResolvedNominalType -> !NominalRepresentation

- Keiro.Dsl.Parser: [documentParsedSource] :: ParsedSourceDocument -> !ParsedSource

- Keiro.Dsl.Parser: [documentSourceIndex] :: ParsedSourceDocument -> !SemanticSourceIndex

- Keiro.Dsl.Parser: [parsedSourceLanguage] :: ParsedSource -> !SourceLanguage

- Keiro.Dsl.Parser: [parsedSpec] :: ParsedSource -> !Spec

- Keiro.Dsl.ProjectionSupply: [supplyObservedTargets] :: ResolvedProjectionSupply -> !NonEmpty Name

- Keiro.Dsl.ProjectionSupply: [supplyOwnerLoc] :: ResolvedProjectionSupply -> !Loc

- Keiro.Dsl.ProjectionSupply: [supplyProjectionOwner] :: ResolvedProjectionSupply -> !Name

- Keiro.Dsl.ProjectionSupply: [supplyQueryLoc] :: ResolvedProjectionSupply -> !Loc

- Keiro.Dsl.ProjectionSupply: [supplyQueryModel] :: ResolvedProjectionSupply -> !Name

- Keiro.Dsl.ProjectionSupply: [supplyRebuildGroup] :: ResolvedProjectionSupply -> !Name

- Keiro.Dsl.ReadModelQueryContract: [qcdCurrent] :: QueryContractDrift -> !Maybe QueryContractIdentity

- Keiro.Dsl.ReadModelQueryContract: [qcdKey] :: QueryContractDrift -> !(Name, QueryContractPosition)

- Keiro.Dsl.ReadModelQueryContract: [qcdPrevious] :: QueryContractDrift -> !Maybe QueryContractIdentity

- Keiro.Dsl.ReadModelQueryContract: [qciMappedDependencies] :: QueryContractIdentity -> ![Name]

- Keiro.Dsl.ReadModelQueryContract: [qciPosition] :: QueryContractIdentity -> !QueryContractPosition

- Keiro.Dsl.ReadModelQueryContract: [qciReadModel] :: QueryContractIdentity -> !Name

- Keiro.Dsl.ReadModelQueryContract: [qciTypeExpression] :: QueryContractIdentity -> !Text

- Keiro.Dsl.RouterSelection: [checkedCommandFields] :: CheckedRouterSelection -> !Map Name CheckedScalarExpr

- Keiro.Dsl.RouterSelection: [checkedCommand] :: CheckedRouterSelection -> !Name

- Keiro.Dsl.RouterSelection: [checkedDedupe] :: CheckedRouterSelection -> !CheckedSelectionDedupe

- Keiro.Dsl.RouterSelection: [checkedEmptyPolicy] :: CheckedRouterSelection -> !CheckedEmptySelectionPolicy

- Keiro.Dsl.RouterSelection: [checkedFailurePolicy] :: CheckedRouterSelection -> !CheckedSelectionFailurePolicy

- Keiro.Dsl.RouterSelection: [checkedFingerprint] :: CheckedRouterSelection -> !Text

- Keiro.Dsl.RouterSelection: [checkedIdentity] :: CheckedRouterSelection -> !Text

- Keiro.Dsl.RouterSelection: [checkedInputBinding] :: CheckedRouterSelection -> !CheckedMappedExpr

- Keiro.Dsl.RouterSelection: [checkedKey] :: CheckedRouterSelection -> !CheckedScalarExpr

- Keiro.Dsl.RouterSelection: [checkedLimit] :: CheckedRouterSelection -> !Natural

- Keiro.Dsl.RouterSelection: [checkedMappedExprRoot] :: CheckedMappedExpr -> !SelectionRoot

- Keiro.Dsl.RouterSelection: [checkedMappedExprType] :: CheckedMappedExpr -> !ResolvedTypeExpr

- Keiro.Dsl.RouterSelection: [checkedMappedTypeConstructor] :: CheckedMappedType -> !Name

- Keiro.Dsl.RouterSelection: [checkedMappedTypeFields] :: CheckedMappedType -> ![ResolvedWireField]

- Keiro.Dsl.RouterSelection: [checkedMappedTypeKey] :: CheckedMappedType -> !MappedKey

- Keiro.Dsl.RouterSelection: [checkedOrder] :: CheckedRouterSelection -> !CheckedSelectionOrder

- Keiro.Dsl.RouterSelection: [checkedPartialPolicy] :: CheckedRouterSelection -> !CheckedPartialDispatchPolicy

- Keiro.Dsl.RouterSelection: [checkedPathField] :: CheckedSelectionPathSegment -> !Name

- Keiro.Dsl.RouterSelection: [checkedPathOwner] :: CheckedSelectionPathSegment -> !MappedKey

- Keiro.Dsl.RouterSelection: [checkedPathWireKey] :: CheckedSelectionPathSegment -> !Text

- Keiro.Dsl.RouterSelection: [checkedPredicate] :: CheckedRouterSelection -> !CheckedScalarExpr

- Keiro.Dsl.RouterSelection: [checkedQueryInputType] :: CheckedReadModelQuery -> !ResolvedTypeExpr

- Keiro.Dsl.RouterSelection: [checkedQueryName] :: CheckedReadModelQuery -> !Name

- Keiro.Dsl.RouterSelection: [checkedQueryResultType] :: CheckedReadModelQuery -> !ResolvedTypeExpr

- Keiro.Dsl.RouterSelection: [checkedQuery] :: CheckedRouterSelection -> !CheckedReadModelQuery

- Keiro.Dsl.RouterSelection: [checkedRecipient] :: CheckedRouterSelection -> !CheckedScalarExpr

- Keiro.Dsl.RouterSelection: [checkedRedeliveryPolicy] :: CheckedRouterSelection -> !CheckedRedeliveryPolicy

- Keiro.Dsl.RouterSelection: [checkedRowBinding] :: CheckedRouterSelection -> !CheckedMappedType

- Keiro.Dsl.RouterSelection: [checkedScalarLoc] :: CheckedScalarExpr -> !Loc

- Keiro.Dsl.RouterSelection: [checkedScalarNode] :: CheckedScalarExpr -> !CheckedScalarNode

- Keiro.Dsl.RouterSelection: [checkedScalarType] :: CheckedScalarExpr -> !SelectionScalarType

- Keiro.Dsl.RouterSelection: [checkedTarget] :: CheckedRouterSelection -> !Name

- Keiro.Dsl.RouterSelection: [checkedUseSites] :: CheckedRouterSelection -> ![UseSite]

- Keiro.Dsl.RouterSelection: [checkedVersion] :: CheckedRouterSelection -> !Natural

- Keiro.Dsl.RouterSelection: [selectionDiagnosticCode] :: RouterSelectionDiagnostic -> !RouterSelectionDiagnosticCode

- Keiro.Dsl.RouterSelection: [selectionDiagnosticLoc] :: RouterSelectionDiagnostic -> !Loc

- Keiro.Dsl.RouterSelection: [selectionDiagnosticMessage] :: RouterSelectionDiagnostic -> !Text

- Keiro.Dsl.Scaffold: [aAggregate] :: Agg -> !Aggregate

- Keiro.Dsl.Scaffold: [aCheckedService] :: Agg -> !CheckedService

- Keiro.Dsl.Scaffold: [aCommands] :: Agg -> ![ResolvedCtor]

- Keiro.Dsl.Scaffold: [aContext] :: Agg -> !Context

- Keiro.Dsl.Scaffold: [aCtxPascal] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aDomainOutcomeTypes] :: Agg -> !Maybe ResolvedDomainOutcomeTypes

- Keiro.Dsl.Scaffold: [aEnums] :: Agg -> ![EnumDecl]

- Keiro.Dsl.Scaffold: [aEvents] :: Agg -> ![ResolvedCtor]

- Keiro.Dsl.Scaffold: [aFoldFingerprint] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aGenPrefix] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aGeneratedNominals] :: Agg -> ![ResolvedNominalType]

- Keiro.Dsl.Scaffold: [aHolePrefix] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aIds] :: Agg -> ![IdDecl]

- Keiro.Dsl.Scaffold: [aLanguageContract] :: Agg -> !EffectiveLanguageContract

- Keiro.Dsl.Scaffold: [aLoc] :: Agg -> !Loc

- Keiro.Dsl.Scaffold: [aName] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aOutputMappings] :: Agg -> !Map (Int, Int) EventOutputMapping

- Keiro.Dsl.Scaffold: [aProjection] :: Agg -> !Maybe ProjectionSpec

- Keiro.Dsl.Scaffold: [aReadModels] :: Agg -> ![ReadModelNode]

- Keiro.Dsl.Scaffold: [aRegs] :: Agg -> ![ResolvedRegister]

- Keiro.Dsl.Scaffold: [aSnapshot] :: Agg -> !Maybe SnapshotSpec

- Keiro.Dsl.Scaffold: [aSpec] :: Agg -> !Spec

- Keiro.Dsl.Scaffold: [aStates] :: Agg -> ![StateDecl]

- Keiro.Dsl.Scaffold: [aSymbols] :: Agg -> !AggregateSymbols

- Keiro.Dsl.Scaffold: [aTransitions] :: Agg -> ![Transition]

- Keiro.Dsl.Scaffold: [aTypeGraph] :: Agg -> !Maybe TypeGraph

- Keiro.Dsl.Scaffold: [aVertexType] :: Agg -> !Text

- Keiro.Dsl.Scaffold: [aWire] :: Agg -> !WireSpec

- Keiro.Dsl.Scaffold: [contextName] :: Context -> !Text

- Keiro.Dsl.Scaffold: [modulePath] :: ScaffoldModule -> !FilePath

- Keiro.Dsl.Scaffold: [moduleText] :: ScaffoldModule -> !Text

- Keiro.Dsl.Scaffold: [nominalDeclaration] :: NominalGenerationOwner -> !ResolvedNominalType

- Keiro.Dsl.Scaffold: [nominalEqualityUsed] :: NominalGenerationOwner -> !Bool

- Keiro.Dsl.Scaffold: [nominalModule] :: NominalGenerationOwner -> !Text

- Keiro.Dsl.Scaffold: [nominalUseAggregate] :: NominalUseSite -> !Name

- Keiro.Dsl.Scaffold: [nominalUseKind] :: NominalUseSite -> !AggregateUseSite

- Keiro.Dsl.Scaffold: [nominalUseSites] :: NominalGenerationOwner -> !Set NominalUseSite

- Keiro.Dsl.Scaffold: [rcFields] :: ResolvedCtor -> ![(ResolvedFieldIdentity, ResolvedAggregateType)]

- Keiro.Dsl.Scaffold: [rcName] :: ResolvedCtor -> !Text

- Keiro.Dsl.Scaffold: [rcUpcastFrom] :: ResolvedCtor -> !Maybe Int

- Keiro.Dsl.Scaffold: [rcVersion] :: ResolvedCtor -> !Int

- Keiro.Dsl.Scaffold: [resolvedNoOpType] :: ResolvedDomainOutcomeTypes -> !ResolvedAggregateType

- Keiro.Dsl.Scaffold: [resolvedRejectionType] :: ResolvedDomainOutcomeTypes -> !ResolvedAggregateType

- Keiro.Dsl.Scaffold: [roleFamily] :: ModuleRole -> !Text

- Keiro.Dsl.Scaffold: [roleOwnerKind] :: ModuleRole -> !Text

- Keiro.Dsl.Scaffold: [roleOwnerName] :: ModuleRole -> !Text

- Keiro.Dsl.Scaffold: [rrInitial] :: ResolvedRegister -> !ResolvedRegisterInitial

- Keiro.Dsl.Scaffold: [rrLoc] :: ResolvedRegister -> !Loc

- Keiro.Dsl.Scaffold: [rrName] :: ResolvedRegister -> !Name

- Keiro.Dsl.Scaffold: [rrType] :: ResolvedRegister -> !ResolvedAggregateType

- Keiro.Dsl.Scaffold: [spBinding] :: StructuralProjection -> !QualifiedValueName

- Keiro.Dsl.Scaffold: [spCanonical] :: StructuralProjection -> !CanonicalTypeId

- Keiro.Dsl.Scaffold: [spOwner] :: StructuralProjection -> !HaskellSource

- Keiro.Dsl.Scaffold: [spPointer] :: StructuralProjection -> !Text

- Keiro.Dsl.Scaffold: [spResult] :: StructuralProjection -> !Text

- Keiro.Dsl.Scaffold: [spSelectors] :: StructuralProjection -> ![(Text, Text)]

- Keiro.Dsl.Scaffold: [spTag] :: StructuralProjection -> !Text

- Keiro.Dsl.Scaffold: [spWitness] :: StructuralProjection -> !Text

- Keiro.Dsl.ScaffoldRecord: [recBehaviorRequirements] :: ScaffoldRecord -> ![BehaviorRecordRow]

- Keiro.Dsl.ScaffoldRecord: [recBindingObligations] :: ScaffoldRecord -> ![BindingHole]

- Keiro.Dsl.ScaffoldRecord: [recFiles] :: ScaffoldRecord -> ![(ModuleKind, FilePath)]

- Keiro.Dsl.ScaffoldRecord: [recIdDomains] :: ScaffoldRecord -> ![Text]

- Keiro.Dsl.ScaffoldRecord: [recLanguageContract] :: ScaffoldRecord -> !EffectiveLanguageContract

- Keiro.Dsl.ScaffoldRecord: [recLayout] :: ScaffoldRecord -> !Text

- Keiro.Dsl.ScaffoldRecord: [recMappings] :: ScaffoldRecord -> ![MappingIdentity]

- Keiro.Dsl.ScaffoldRecord: [recModuleRoles] :: ScaffoldRecord -> ![ScaffoldModuleRoleRow]

- Keiro.Dsl.ScaffoldRecord: [recModuleRoot] :: ScaffoldRecord -> !Text

- Keiro.Dsl.ScaffoldRecord: [recNamingEdition] :: ScaffoldRecord -> !GeneratedHaskellNamingEdition

- Keiro.Dsl.ScaffoldRecord: [recNominalEqualities] :: ScaffoldRecord -> ![Text]

- Keiro.Dsl.ScaffoldRecord: [recProjectionCatalogFacts] :: ScaffoldRecord -> ![Text]

- Keiro.Dsl.ScaffoldRecord: [recQueryContractBaseline] :: ScaffoldRecord -> !Bool

- Keiro.Dsl.ScaffoldRecord: [recQueryContracts] :: ScaffoldRecord -> ![QueryContractIdentity]

- Keiro.Dsl.ScaffoldRecord: [recRouterSelections] :: ScaffoldRecord -> ![RouterSelectionSnapshot]

- Keiro.Dsl.ScaffoldRecord: [recSemanticImpact] :: ScaffoldRecord -> !Maybe SemanticImpactSnapshot

- Keiro.Dsl.ScaffoldRecord: [recSourceLanguage] :: ScaffoldRecord -> !SourceLanguage

- Keiro.Dsl.ScaffoldRecord: [recSpecPath] :: ScaffoldRecord -> !Text

- Keiro.Dsl.ScaffoldRecord: [srrKind] :: ScaffoldModuleRoleRow -> !ModuleKind

- Keiro.Dsl.ScaffoldRecord: [srrPath] :: ScaffoldModuleRoleRow -> !FilePath

- Keiro.Dsl.ScaffoldRecord: [srrRole] :: ScaffoldModuleRoleRow -> !ModuleRole

- Keiro.Dsl.ScaffoldRun: [artifactCategory] :: GeneratedArtifactImpact -> !GeneratedArtifactCategory

- Keiro.Dsl.ScaffoldRun: [artifactDisposition] :: GeneratedArtifactImpact -> !WriteDisposition

- Keiro.Dsl.ScaffoldRun: [artifactPath] :: GeneratedArtifactImpact -> !FilePath

- Keiro.Dsl.ScaffoldRun: [artifactRole] :: GeneratedArtifactImpact -> !ModuleRole

- Keiro.Dsl.ScaffoldRun: [driftCurrent] :: MappingDrift -> !Maybe MappingIdentity

- Keiro.Dsl.ScaffoldRun: [driftPrevious] :: MappingDrift -> !Maybe MappingIdentity

- Keiro.Dsl.ScaffoldRun: [driftSpecName] :: MappingDrift -> !Text

- Keiro.Dsl.ScaffoldRun: [languageDriftCurrent] :: SourceLanguageDrift -> !SourceLanguage

- Keiro.Dsl.ScaffoldRun: [languageDriftPrevious] :: SourceLanguageDrift -> !SourceLanguage

- Keiro.Dsl.ScaffoldRun: [qcmHolePath] :: QueryContractMigration -> !FilePath

- Keiro.Dsl.ScaffoldRun: [qcmOwner] :: QueryContractMigration -> !Text

- Keiro.Dsl.ScaffoldRun: [qcmRequiredImport] :: QueryContractMigration -> !Text

- Keiro.Dsl.ScaffoldRun: [reportAddedBehavior] :: ScaffoldReport -> ![BehaviorRecordRow]

- Keiro.Dsl.ScaffoldRun: [reportConformancePackage] :: ScaffoldReport -> !Maybe ConformancePackageReport

- Keiro.Dsl.ScaffoldRun: [reportConstraintPlan] :: ScaffoldReport -> ![Text]

- Keiro.Dsl.ScaffoldRun: [reportConsumerPlan] :: ScaffoldReport -> !ConsumerPlan

- Keiro.Dsl.ScaffoldRun: [reportContext] :: ScaffoldReport -> !Context

- Keiro.Dsl.ScaffoldRun: [reportDispositions] :: ScaffoldReport -> ![(ScaffoldModule, WriteDisposition)]

- Keiro.Dsl.ScaffoldRun: [reportGeneratedArtifactImpact] :: ScaffoldReport -> ![GeneratedArtifactImpact]

- Keiro.Dsl.ScaffoldRun: [reportInertNodes] :: ScaffoldReport -> ![(Text, Text)]

- Keiro.Dsl.ScaffoldRun: [reportManifestPath] :: ScaffoldReport -> !FilePath

- Keiro.Dsl.ScaffoldRun: [reportMappingDrift] :: ScaffoldReport -> ![MappingDrift]

- Keiro.Dsl.ScaffoldRun: [reportNameMoves] :: ScaffoldReport -> ![SourceMove]

- Keiro.Dsl.ScaffoldRun: [reportNewHoles] :: ScaffoldReport -> ![BindingHole]

- Keiro.Dsl.ScaffoldRun: [reportObsoleteOutputHooks] :: ScaffoldReport -> ![(Text, Text)]

- Keiro.Dsl.ScaffoldRun: [reportOutDir] :: ScaffoldReport -> !FilePath

- Keiro.Dsl.ScaffoldRun: [reportPreviousSpecPath] :: ScaffoldReport -> !Maybe Text

- Keiro.Dsl.ScaffoldRun: [reportProjectionMappedImpact] :: ScaffoldReport -> !Maybe ProjectionMappedImpact

- Keiro.Dsl.ScaffoldRun: [reportQueryContractBaselineUnavailable] :: ScaffoldReport -> !Bool

- Keiro.Dsl.ScaffoldRun: [reportQueryContractDrift] :: ScaffoldReport -> ![QueryContractDrift]

- Keiro.Dsl.ScaffoldRun: [reportQueryContractMigrations] :: ScaffoldReport -> ![QueryContractMigration]

- Keiro.Dsl.ScaffoldRun: [reportRecordPath] :: ScaffoldReport -> !FilePath

- Keiro.Dsl.ScaffoldRun: [reportRemovedBehavior] :: ScaffoldReport -> ![BehaviorRecordRow]

- Keiro.Dsl.ScaffoldRun: [reportRouterSelectionDrift] :: ScaffoldReport -> ![RouterSelectionDrift]

- Keiro.Dsl.ScaffoldRun: [reportSemanticImpact] :: ScaffoldReport -> !SemanticImpactReport

- Keiro.Dsl.ScaffoldRun: [reportSidecarMoves] :: ScaffoldReport -> ![SidecarMove]

- Keiro.Dsl.ScaffoldRun: [reportSourceLanguageDrift] :: ScaffoldReport -> !Maybe SourceLanguageDrift

- Keiro.Dsl.ScaffoldRun: [reportSpecPath] :: ScaffoldReport -> !FilePath

- Keiro.Dsl.ScaffoldRun: [reportStale] :: ScaffoldReport -> ![StaleModule]

- Keiro.Dsl.ScaffoldRun: [staleGeneratedEvidence] :: StaleModule -> !Maybe StaleGeneratedEvidence

- Keiro.Dsl.ScaffoldRun: [staleKind] :: StaleModule -> !ModuleKind

- Keiro.Dsl.ScaffoldRun: [stalePath] :: StaleModule -> !FilePath

- Keiro.Dsl.SemanticContract: effectiveContractLanguageVersion :: EffectiveLanguageContract -> LanguageVersion

- Keiro.Dsl.SemanticContract: effectiveRuntimeProfile :: EffectiveLanguageContract -> RuntimeSemanticsProfile

- Keiro.Dsl.SemanticImpact: [evidenceConsumer] :: MappedRootEvidence -> !MappedConsumer

- Keiro.Dsl.SemanticImpact: [evidenceOperation] :: MappedRootEvidence -> !Maybe Text

- Keiro.Dsl.SemanticImpact: [evidencePath] :: MappedRootEvidence -> !Text

- Keiro.Dsl.SemanticImpact: [evidenceRootKind] :: MappedRootEvidence -> !MappedRootKind

- Keiro.Dsl.SemanticImpact: [impactAggregateDeclarations] :: SemanticImpact -> !Map MappedConsumer (Set MappedKey)

- Keiro.Dsl.SemanticImpact: [impactCurrentConsequences] :: MappedImpactDelta -> !Maybe (Set MappedConsequence)

- Keiro.Dsl.SemanticImpact: [impactCurrentConsumers] :: MappedImpactDelta -> !Set MappedConsumer

- Keiro.Dsl.SemanticImpact: [impactCurrentEvidence] :: MappedImpactDelta -> !Maybe (Set MappedRootEvidence)

- Keiro.Dsl.SemanticImpact: [impactDeclarationConsequences] :: SemanticImpact -> !Map MappedKey (Set MappedConsequence)

- Keiro.Dsl.SemanticImpact: [impactDeclarationConsumers] :: SemanticImpact -> !Map MappedKey (Set MappedConsumer)

- Keiro.Dsl.SemanticImpact: [impactDeclarationEvidence] :: SemanticImpact -> !Map MappedKey (Set MappedRootEvidence)

- Keiro.Dsl.SemanticImpact: [impactDeclarationIdentities] :: SemanticImpact -> !Map MappedKey Text

- Keiro.Dsl.SemanticImpact: [impactDeclaration] :: MappedImpactDelta -> !MappedKey

- Keiro.Dsl.SemanticImpact: [impactPreviousConsequences] :: MappedImpactDelta -> !Maybe (Set MappedConsequence)

- Keiro.Dsl.SemanticImpact: [impactPreviousConsumers] :: MappedImpactDelta -> !Set MappedConsumer

- Keiro.Dsl.SemanticImpact: [impactPreviousEvidence] :: MappedImpactDelta -> !Maybe (Set MappedRootEvidence)

- Keiro.Dsl.SemanticImpact: [impactRoots] :: SemanticImpact -> ![MappedRoot]

- Keiro.Dsl.SemanticImpact: [impactServiceConformance] :: MappedImpactDelta -> !Bool

- Keiro.Dsl.SemanticImpact: [impactServiceDeclarations] :: SemanticImpact -> !Set MappedKey

- Keiro.Dsl.SemanticImpact: [impactUnsupportedProjectionSources] :: SemanticImpact -> ![UnsupportedProjectionSource]

- Keiro.Dsl.SemanticImpact: [impactUsePaths] :: SemanticImpact -> !Map MappedKey [UsePath]

- Keiro.Dsl.SemanticImpact: [mappedRootConsumer] :: MappedRoot -> !MappedConsumer

- Keiro.Dsl.SemanticImpact: [mappedRootDeclaration] :: MappedRoot -> !MappedKey

- Keiro.Dsl.SemanticImpact: [mappedRootKind] :: MappedRoot -> !MappedRootKind

- Keiro.Dsl.SemanticImpact: [mappedRootUseSite] :: MappedRoot -> !UseSite

- Keiro.Dsl.SemanticImpact: [semanticReportCurrent] :: SemanticImpactReport -> !SemanticImpactSnapshot

- Keiro.Dsl.SemanticImpact: [semanticReportDeclarations] :: SemanticImpactReport -> ![MappedKey]

- Keiro.Dsl.SemanticImpact: [semanticReportDeltas] :: SemanticImpactReport -> ![MappedImpactDelta]

- Keiro.Dsl.SemanticImpact: [semanticReportPrevious] :: SemanticImpactReport -> !Maybe SemanticImpactSnapshot

- Keiro.Dsl.SemanticImpact: [snapshotDeclarationIdentities] :: SemanticImpactSnapshot -> !Map MappedKey Text

- Keiro.Dsl.SemanticImpact: [snapshotMappedConsequences] :: SemanticImpactSnapshot -> !Maybe (Map MappedKey (Set MappedConsequence))

- Keiro.Dsl.SemanticImpact: [snapshotMappedConsumers] :: SemanticImpactSnapshot -> !Map MappedKey (Set MappedConsumer)

- Keiro.Dsl.SemanticImpact: [snapshotMappedEvidence] :: SemanticImpactSnapshot -> !Maybe (Map MappedKey (Set MappedRootEvidence))

- Keiro.Dsl.SemanticImpact: [snapshotServiceInventory] :: SemanticImpactSnapshot -> !Set MappedKey

- Keiro.Dsl.SidecarMigration: [sidecarBackupPath] :: SidecarMove -> !Maybe FilePath

- Keiro.Dsl.SidecarMigration: [sidecarMoveDisposition] :: SidecarMove -> !SidecarMoveDisposition

- Keiro.Dsl.SidecarMigration: [sidecarNewPath] :: SidecarMove -> !FilePath

- Keiro.Dsl.SidecarMigration: [sidecarOldPath] :: SidecarMove -> !FilePath

- Keiro.Dsl.SourceIndex: [documentParsedSource] :: ParsedSourceDocument -> !ParsedSource

- Keiro.Dsl.SourceIndex: [documentSourceIndex] :: ParsedSourceDocument -> !SemanticSourceIndex

- Keiro.Dsl.SourceIndex: [failureCode] :: SourceIndexFailure -> !SourceIndexFailureCode

- Keiro.Dsl.SourceIndex: [failureMessage] :: SourceIndexFailure -> !Text

- Keiro.Dsl.SourceIndex: [failureSpan] :: SourceIndexFailure -> !Maybe SourceSpan

- Keiro.Dsl.SourceIndex: [failureSubject] :: SourceIndexFailure -> !Maybe SourceSubject

- Keiro.Dsl.TypeGraph: [odCodecIdentity] :: OpaqueDecl -> !CodecIdentity

- Keiro.Dsl.TypeGraph: [odCodecVersion] :: OpaqueDecl -> !CodecVersion

- Keiro.Dsl.TypeGraph: [odFixtures] :: OpaqueDecl -> !QualifiedValueName

- Keiro.Dsl.TypeGraph: [odHaskell] :: OpaqueDecl -> !HaskellSource

- Keiro.Dsl.TypeGraph: [odInitial] :: OpaqueDecl -> !Maybe QualifiedValueName

- Keiro.Dsl.TypeGraph: [odLoc] :: OpaqueDecl -> !Loc

- Keiro.Dsl.TypeGraph: [odName] :: OpaqueDecl -> !Name

- Keiro.Dsl.TypeGraph: [rwaCtor] :: ResolvedWireArm -> !Name

- Keiro.Dsl.TypeGraph: [rwaLoc] :: ResolvedWireArm -> !Loc

- Keiro.Dsl.TypeGraph: [rwaPayload] :: ResolvedWireArm -> !Maybe ResolvedTypeExpr

- Keiro.Dsl.TypeGraph: [rwaTag] :: ResolvedWireArm -> !Text

- Keiro.Dsl.TypeGraph: [rwfHaskell] :: ResolvedWireField -> !Name

- Keiro.Dsl.TypeGraph: [rwfKey] :: ResolvedWireField -> !Text

- Keiro.Dsl.TypeGraph: [rwfLoc] :: ResolvedWireField -> !Loc

- Keiro.Dsl.TypeGraph: [rwfOnMissing] :: ResolvedWireField -> !Maybe OnMissing

- Keiro.Dsl.TypeGraph: [rwfPresence] :: ResolvedWireField -> !Presence

- Keiro.Dsl.TypeGraph: [rwfType] :: ResolvedWireField -> !ResolvedTypeExpr

- Keiro.Dsl.TypeGraph: [sdBindingVersion] :: StructuralDecl -> !BindingVersion

- Keiro.Dsl.TypeGraph: [sdBinding] :: StructuralDecl -> !QualifiedValueName

- Keiro.Dsl.TypeGraph: [sdCanonical] :: StructuralDecl -> !CanonicalTypeId

- Keiro.Dsl.TypeGraph: [sdFixtures] :: StructuralDecl -> !QualifiedValueName

- Keiro.Dsl.TypeGraph: [sdHaskell] :: StructuralDecl -> !HaskellSource

- Keiro.Dsl.TypeGraph: [sdInitial] :: StructuralDecl -> !Maybe QualifiedValueName

- Keiro.Dsl.TypeGraph: [sdLoc] :: StructuralDecl -> !Loc

- Keiro.Dsl.TypeGraph: [sdName] :: StructuralDecl -> !Name

- Keiro.Dsl.TypeGraph: [tgDeclarations] :: TypeGraph -> !Map MappedKey ResolvedMappedDecl

- Keiro.Dsl.TypeGraph: [tgDerivedMappedConsumers] :: TypeGraph -> ![DerivedMappedConsumer]

- Keiro.Dsl.TypeGraph: [tgProjectionOperationalIdentities] :: TypeGraph -> !Map DerivedMappedConsumer Text

- Keiro.Dsl.TypeGraph: [tgReachability] :: TypeGraph -> !Map MappedKey (Set MappedKey)

- Keiro.Dsl.TypeGraph: [tgReplayableProjectionGroups] :: TypeGraph -> !Map DerivedMappedConsumer Name

- Keiro.Dsl.TypeGraph: [tgRootSegments] :: TypeGraph -> !Map UseSite [PathSeg]

- Keiro.Dsl.TypeGraph: [tgUnsupportedProjectionSources] :: TypeGraph -> ![UnsupportedProjectionSource]

- Keiro.Dsl.TypeGraph: [tgUseSites] :: TypeGraph -> ![UseSite]

- Keiro.Dsl.TypeGraph: [upRoot] :: UsePath -> !UseSite

- Keiro.Dsl.TypeGraph: [upSegments] :: UsePath -> ![PathSeg]

- Keiro.Dsl.Workspace: [oiDeclarations] :: OwnershipIndex -> !Map (Text, Name) (FilePath, Loc)

- Keiro.Dsl.Workspace: [oiNodes] :: OwnershipIndex -> !Map (Text, Name) (FilePath, Loc)

- Keiro.Dsl.Workspace: [wdCode] :: WorkspaceDiagnostic -> !DiagnosticCode

- Keiro.Dsl.Workspace: [wdLocations] :: WorkspaceDiagnostic -> !NonEmpty WorkspaceLocation

- Keiro.Dsl.Workspace: [wdMessage] :: WorkspaceDiagnostic -> !Text

- Keiro.Dsl.Workspace: [wdSeverity] :: WorkspaceDiagnostic -> !Severity

- Keiro.Dsl.Workspace: [wdSourceLanguageCause] :: WorkspaceDiagnostic -> !Maybe SourceLanguageDiagnostic

- Keiro.Dsl.Workspace: [wlFile] :: WorkspaceLocation -> !WorkspaceFile

- Keiro.Dsl.Workspace: [wlLine] :: WorkspaceLocation -> !Int

- Keiro.Dsl.Workspace: [wlRole] :: WorkspaceLocation -> !Text

- Keiro.Dsl.Workspace: [wmLineBase] :: WorkspaceMember -> !Int

- Keiro.Dsl.Workspace: [wmLineCount] :: WorkspaceMember -> !Int

- Keiro.Dsl.Workspace: [wmPath] :: WorkspaceMember -> !FilePath

- Keiro.Dsl.Workspace: [wmSourceIndex] :: WorkspaceMember -> !SemanticSourceIndex

- Keiro.Dsl.Workspace: [wmSourceLanguage] :: WorkspaceMember -> !SourceLanguage

- Keiro.Dsl.Workspace: [wmSpec] :: WorkspaceMember -> !Spec

- Keiro.Dsl.Workspace: [wmfLayoutLoc] :: WorkspaceManifest -> !Loc

- Keiro.Dsl.Workspace: [wmfLayout] :: WorkspaceManifest -> !Maybe Placement

- Keiro.Dsl.Workspace: [wmfMembers] :: WorkspaceManifest -> !NonEmpty WorkspaceMemberRef

- Keiro.Dsl.Workspace: [wmfModuleRootLoc] :: WorkspaceManifest -> !Loc

- Keiro.Dsl.Workspace: [wmfModuleRoot] :: WorkspaceManifest -> !Maybe Text

- Keiro.Dsl.Workspace: [wmfRuntimePackageLoc] :: WorkspaceManifest -> !Loc

- Keiro.Dsl.Workspace: [wmfRuntimePackage] :: WorkspaceManifest -> !Maybe RuntimePackageName

- Keiro.Dsl.Workspace: [wmfServiceLoc] :: WorkspaceManifest -> !Loc

- Keiro.Dsl.Workspace: [wmfService] :: WorkspaceManifest -> !Text

- Keiro.Dsl.Workspace: [wmrLoc] :: WorkspaceMemberRef -> !Loc

- Keiro.Dsl.Workspace: [wmrPath] :: WorkspaceMemberRef -> !FilePath

- Keiro.Dsl.Workspace: [wsContext] :: WorkspaceSpec -> !Name

- Keiro.Dsl.Workspace: [wsLanguageContract] :: WorkspaceSpec -> !EffectiveLanguageContract

- Keiro.Dsl.Workspace: [wsLayout] :: WorkspaceSpec -> !Maybe Placement

- Keiro.Dsl.Workspace: [wsLineMap] :: WorkspaceSpec -> !LineMap

- Keiro.Dsl.Workspace: [wsManifestPath] :: WorkspaceSpec -> !FilePath

- Keiro.Dsl.Workspace: [wsMembers] :: WorkspaceSpec -> ![WorkspaceMember]

- Keiro.Dsl.Workspace: [wsMergedSpec] :: WorkspaceSpec -> !Spec

- Keiro.Dsl.Workspace: [wsModuleRoot] :: WorkspaceSpec -> !Maybe Text

- Keiro.Dsl.Workspace: [wsOwnership] :: WorkspaceSpec -> !OwnershipIndex

- Keiro.Dsl.Workspace: [wsRuntimePackage] :: WorkspaceSpec -> !Maybe RuntimePackageName

- Keiro.Dsl.Workspace: [wsService] :: WorkspaceSpec -> !Text

- Keiro.Dsl.Workspace: [wsSourceIndex] :: WorkspaceSpec -> !SemanticSourceIndex

- Keiro.Dsl.WorkspaceAdoption: [cfEvidence] :: ClaimedFile -> !ClaimEvidence

- Keiro.Dsl.WorkspaceAdoption: [cfPath] :: ClaimedFile -> !FilePath

- Keiro.Dsl.WorkspaceAdoption: [cfSource] :: ClaimedFile -> !Maybe Text

- Keiro.Dsl.WorkspaceAdoption: [cfSpec] :: ClaimedFile -> !Maybe Text

- Keiro.Dsl.WorkspaceAdoption: [mrClaimed] :: MigrationReport -> ![ClaimedFile]

- Keiro.Dsl.WorkspaceAdoption: [mrLegacyRecord] :: MigrationReport -> !Maybe (FilePath, Text)

- Keiro.Dsl.WorkspaceAdoption: [mrLikelyStale] :: MigrationReport -> ![StaleModule]

- Keiro.Dsl.WorkspaceAdoption: [mrService] :: MigrationReport -> !Text

- Keiro.Dsl.WorkspaceAdoption: [mrUnclaimed] :: MigrationReport -> ![FilePath]

- Keiro.Dsl.WorkspaceDiff: [osFile] :: OwnedSite -> !FilePath

- Keiro.Dsl.WorkspaceDiff: [osLine] :: OwnedSite -> !Int

- Keiro.Dsl.WorkspaceDiff: [wcChange] :: WorkspaceChange -> !Change

- Keiro.Dsl.WorkspaceDiff: [wcDeclarationSite] :: WorkspaceChange -> !Maybe OwnedSite

- Keiro.Dsl.WorkspaceDiff: [wcUseSites] :: WorkspaceChange -> ![(Text, Maybe OwnedSite)]

- Keiro.Dsl.WorkspaceDiff: [wmAdoptionBaseline] :: WorkspaceMeta -> !Bool

- Keiro.Dsl.WorkspaceDiff: [wmIdentity] :: WorkspaceMeta -> !Text

- Keiro.Dsl.WorkspaceDiff: [wmManifest] :: WorkspaceMeta -> !FilePath

- Keiro.Dsl.WorkspaceDiff: [wmMembersNew] :: WorkspaceMeta -> ![FilePath]

- Keiro.Dsl.WorkspaceDiff: [wmMembersOld] :: WorkspaceMeta -> ![FilePath]

- Keiro.Dsl.WorkspaceDiff: [wmSince] :: WorkspaceMeta -> !Text

- Keiro.Dsl.WorkspaceRecord: [adEvidence] :: AdoptedRow -> !Text

- Keiro.Dsl.WorkspaceRecord: [adPath] :: AdoptedRow -> !FilePath

- Keiro.Dsl.WorkspaceRecord: [adSource] :: AdoptedRow -> !Maybe Text

- Keiro.Dsl.WorkspaceRecord: [adSpec] :: AdoptedRow -> !Maybe Text

- Keiro.Dsl.WorkspaceRecord: [wrAdopted] :: WorkspaceRecord -> ![AdoptedRow]

- Keiro.Dsl.WorkspaceRecord: [wrBehaviorRequirements] :: WorkspaceRecord -> ![BehaviorRecordRow]

- Keiro.Dsl.WorkspaceRecord: [wrBindingObligations] :: WorkspaceRecord -> ![BindingHole]

- Keiro.Dsl.WorkspaceRecord: [wrContext] :: WorkspaceRecord -> !Text

- Keiro.Dsl.WorkspaceRecord: [wrIdDomains] :: WorkspaceRecord -> ![Text]

- Keiro.Dsl.WorkspaceRecord: [wrLanguageContract] :: WorkspaceRecord -> !EffectiveLanguageContract

- Keiro.Dsl.WorkspaceRecord: [wrLayout] :: WorkspaceRecord -> !Text

- Keiro.Dsl.WorkspaceRecord: [wrManifest] :: WorkspaceRecord -> !Text

- Keiro.Dsl.WorkspaceRecord: [wrMappings] :: WorkspaceRecord -> ![MappingIdentity]

- Keiro.Dsl.WorkspaceRecord: [wrMembers] :: WorkspaceRecord -> ![FilePath]

- Keiro.Dsl.WorkspaceRecord: [wrModuleRoot] :: WorkspaceRecord -> !Text

- Keiro.Dsl.WorkspaceRecord: [wrModules] :: WorkspaceRecord -> ![WorkspaceModuleRow]

- Keiro.Dsl.WorkspaceRecord: [wrNamingEdition] :: WorkspaceRecord -> !GeneratedHaskellNamingEdition

- Keiro.Dsl.WorkspaceRecord: [wrNominalEqualities] :: WorkspaceRecord -> ![Text]

- Keiro.Dsl.WorkspaceRecord: [wrProjectionCatalogFacts] :: WorkspaceRecord -> ![Text]

- Keiro.Dsl.WorkspaceRecord: [wrQueryContractBaseline] :: WorkspaceRecord -> !Bool

- Keiro.Dsl.WorkspaceRecord: [wrQueryContracts] :: WorkspaceRecord -> ![QueryContractIdentity]

- Keiro.Dsl.WorkspaceRecord: [wrRouterSelections] :: WorkspaceRecord -> ![RouterSelectionSnapshot]

- Keiro.Dsl.WorkspaceRecord: [wrSemanticImpact] :: WorkspaceRecord -> !Maybe SemanticImpactSnapshot

- Keiro.Dsl.WorkspaceRecord: [wrService] :: WorkspaceRecord -> !Text

- Keiro.Dsl.WorkspaceRecord: [wrSourceLanguages] :: WorkspaceRecord -> ![WorkspaceSourceLanguageRow]

- Keiro.Dsl.WorkspaceRecord: [wrmKind] :: WorkspaceModuleRow -> !ModuleKind

- Keiro.Dsl.WorkspaceRecord: [wrmOwner] :: WorkspaceModuleRow -> !Maybe FilePath

- Keiro.Dsl.WorkspaceRecord: [wrmPath] :: WorkspaceModuleRow -> !FilePath

- Keiro.Dsl.WorkspaceRecord: [wrmRole] :: WorkspaceModuleRow -> !Maybe ModuleRole

- Keiro.Dsl.WorkspaceRecord: [wrslPath] :: WorkspaceSourceLanguageRow -> !FilePath

- Keiro.Dsl.WorkspaceRecord: [wrslSourceLanguage] :: WorkspaceSourceLanguageRow -> !SourceLanguage

- Keiro.Dsl.WorkspaceScaffold: [omCurrent] :: OwnershipMove -> !Maybe FilePath

- Keiro.Dsl.WorkspaceScaffold: [omPath] :: OwnershipMove -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [omPrevious] :: OwnershipMove -> !Maybe FilePath

- Keiro.Dsl.WorkspaceScaffold: [wpCheckedService] :: WorkspacePlan -> !CheckedService

- Keiro.Dsl.WorkspaceScaffold: [wpConformancePackage] :: WorkspacePlan -> !Maybe ConformancePackagePlan

- Keiro.Dsl.WorkspaceScaffold: [wpContext] :: WorkspacePlan -> !Context

- Keiro.Dsl.WorkspaceScaffold: [wpGoldenRoot] :: WorkspacePlan -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wpModules] :: WorkspacePlan -> ![(ScaffoldModule, ModuleProvenance)]

- Keiro.Dsl.WorkspaceScaffold: [wpRuntimePackage] :: WorkspacePlan -> !Maybe RuntimePackageName

- Keiro.Dsl.WorkspaceScaffold: [wpWorkspace] :: WorkspacePlan -> !WorkspaceSpec

- Keiro.Dsl.WorkspaceScaffold: [wsldCurrent] :: WorkspaceSourceLanguageDrift -> !SourceLanguage

- Keiro.Dsl.WorkspaceScaffold: [wsldPath] :: WorkspaceSourceLanguageDrift -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wsldPrevious] :: WorkspaceSourceLanguageDrift -> !SourceLanguage

- Keiro.Dsl.WorkspaceScaffold: [wsrAddedBehavior] :: WorkspaceScaffoldReport -> ![BehaviorRecordRow]

- Keiro.Dsl.WorkspaceScaffold: [wsrBuildManifestPath] :: WorkspaceScaffoldReport -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wsrConformancePackage] :: WorkspaceScaffoldReport -> !Maybe ConformancePackageReport

- Keiro.Dsl.WorkspaceScaffold: [wsrConstraintPlan] :: WorkspaceScaffoldReport -> ![Text]

- Keiro.Dsl.WorkspaceScaffold: [wsrConsumerPlan] :: WorkspaceScaffoldReport -> !ConsumerPlan

- Keiro.Dsl.WorkspaceScaffold: [wsrContext] :: WorkspaceScaffoldReport -> !Context

- Keiro.Dsl.WorkspaceScaffold: [wsrDispositions] :: WorkspaceScaffoldReport -> ![(ScaffoldModule, ModuleProvenance, WriteDisposition)]

- Keiro.Dsl.WorkspaceScaffold: [wsrGeneratedArtifactImpact] :: WorkspaceScaffoldReport -> ![GeneratedArtifactImpact]

- Keiro.Dsl.WorkspaceScaffold: [wsrInertNodes] :: WorkspaceScaffoldReport -> ![(Text, Text)]

- Keiro.Dsl.WorkspaceScaffold: [wsrManifestPath] :: WorkspaceScaffoldReport -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wsrMappingDrift] :: WorkspaceScaffoldReport -> ![MappingDrift]

- Keiro.Dsl.WorkspaceScaffold: [wsrMembers] :: WorkspaceScaffoldReport -> ![FilePath]

- Keiro.Dsl.WorkspaceScaffold: [wsrMigration] :: WorkspaceScaffoldReport -> !Maybe MigrationReport

- Keiro.Dsl.WorkspaceScaffold: [wsrNameMoves] :: WorkspaceScaffoldReport -> ![SourceMove]

- Keiro.Dsl.WorkspaceScaffold: [wsrNewHoles] :: WorkspaceScaffoldReport -> ![BindingHole]

- Keiro.Dsl.WorkspaceScaffold: [wsrObsoleteOutputHooks] :: WorkspaceScaffoldReport -> ![(Text, Text)]

- Keiro.Dsl.WorkspaceScaffold: [wsrOutDir] :: WorkspaceScaffoldReport -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wsrOwnershipMoves] :: WorkspaceScaffoldReport -> ![OwnershipMove]

- Keiro.Dsl.WorkspaceScaffold: [wsrPreviousManifest] :: WorkspaceScaffoldReport -> !Maybe Text

- Keiro.Dsl.WorkspaceScaffold: [wsrProjectionMappedImpact] :: WorkspaceScaffoldReport -> !Maybe ProjectionMappedImpact

- Keiro.Dsl.WorkspaceScaffold: [wsrQueryContractBaselineUnavailable] :: WorkspaceScaffoldReport -> !Bool

- Keiro.Dsl.WorkspaceScaffold: [wsrQueryContractDrift] :: WorkspaceScaffoldReport -> ![QueryContractDrift]

- Keiro.Dsl.WorkspaceScaffold: [wsrQueryContractMigrations] :: WorkspaceScaffoldReport -> ![QueryContractMigration]

- Keiro.Dsl.WorkspaceScaffold: [wsrRecordPath] :: WorkspaceScaffoldReport -> !FilePath

- Keiro.Dsl.WorkspaceScaffold: [wsrRemovedBehavior] :: WorkspaceScaffoldReport -> ![BehaviorRecordRow]

- Keiro.Dsl.WorkspaceScaffold: [wsrRouterSelectionDrift] :: WorkspaceScaffoldReport -> ![RouterSelectionDrift]

- Keiro.Dsl.WorkspaceScaffold: [wsrSemanticImpact] :: WorkspaceScaffoldReport -> !SemanticImpactReport

- Keiro.Dsl.WorkspaceScaffold: [wsrService] :: WorkspaceScaffoldReport -> !Text

- Keiro.Dsl.WorkspaceScaffold: [wsrSidecarMoves] :: WorkspaceScaffoldReport -> ![SidecarMove]

- Keiro.Dsl.WorkspaceScaffold: [wsrSourceLanguageDrift] :: WorkspaceScaffoldReport -> ![WorkspaceSourceLanguageDrift]

- Keiro.Dsl.WorkspaceScaffold: [wsrStale] :: WorkspaceScaffoldReport -> ![StaleModule]

+ Keiro.Dsl.AggregateType: [loc] :: AggregateTypeError -> !Loc

+ Keiro.Dsl.AggregateType: [reason] :: AggregateTypeError -> !AggregateTypeErrorReason

+ Keiro.Dsl.AggregateType: [useSite] :: AggregateTypeError -> !AggregateUseSite

+ Keiro.Dsl.BehaviorCoverage: [aggregate] :: BehaviorRecordRow -> !Name

+ Keiro.Dsl.BehaviorCoverage: [canonical] :: BehaviorRequirement -> !Text

+ Keiro.Dsl.BehaviorCoverage: [command] :: BehaviorRecordRow -> !Name

+ Keiro.Dsl.BehaviorCoverage: [context] :: BehaviorRequirement -> !Name

+ Keiro.Dsl.BehaviorCoverage: [domainOutcome] :: BehaviorRequirement -> !Maybe TransitionOutcome

+ Keiro.Dsl.BehaviorCoverage: [events] :: BehaviorRequirement -> ![Name]

+ Keiro.Dsl.BehaviorCoverage: [evidence] :: BehaviorRecordRow -> !EvidenceLevel

+ Keiro.Dsl.BehaviorCoverage: [exactLocation] :: BehaviorRequirement -> !Maybe BehaviorExactLocation

+ Keiro.Dsl.BehaviorCoverage: [guardCoverage] :: BehaviorRequirement -> !GuardCoverage

+ Keiro.Dsl.BehaviorCoverage: [key] :: BehaviorRecordRow -> !BehaviorKey

+ Keiro.Dsl.BehaviorCoverage: [kind] :: BehaviorRecordRow -> !ObligationKind

+ Keiro.Dsl.BehaviorCoverage: [location] :: BehaviorRequirement -> !Loc

+ Keiro.Dsl.BehaviorCoverage: [mode] :: BehaviorRequirement -> !Maybe TransitionMode

+ Keiro.Dsl.BehaviorCoverage: [origin] :: BehaviorRequirement -> !RequirementOrigin

+ Keiro.Dsl.BehaviorCoverage: [outputs] :: BehaviorRecordRow -> ![OutputEvidence]

+ Keiro.Dsl.BehaviorCoverage: [owner] :: BehaviorRecordRow -> !Maybe FilePath

+ Keiro.Dsl.BehaviorCoverage: [requirements] :: BehaviorObligationsReport -> ![BehaviorRequirement]

+ Keiro.Dsl.BehaviorCoverage: [sourceColumn] :: BehaviorExactLocation -> !Int

+ Keiro.Dsl.BehaviorCoverage: [sourceFile] :: BehaviorExactLocation -> !FilePath

+ Keiro.Dsl.BehaviorCoverage: [sourceLine] :: BehaviorExactLocation -> !Int

+ Keiro.Dsl.BehaviorCoverage: [source] :: BehaviorRecordRow -> !Name

+ Keiro.Dsl.BehaviorCoverage: [subject] :: BehaviorObligationsReport -> !FilePath

+ Keiro.Dsl.BehaviorCoverage: [target] :: BehaviorRequirement -> !Maybe Name

+ Keiro.Dsl.BehaviorCoverage: [workspaceService] :: BehaviorObligationsReport -> !Maybe Text

+ Keiro.Dsl.BehaviorCoverage: unBehaviorKey :: BehaviorKey -> Text

+ Keiro.Dsl.BehaviorSourceMap: [aggregate] :: BehaviorSourceFailure -> !Text

+ Keiro.Dsl.BehaviorSourceMap: [code] :: BehaviorSourceFailure -> !BehaviorSourceFailureCode

+ Keiro.Dsl.BehaviorSourceMap: [column] :: BehaviorSourceEntry -> !Int

+ Keiro.Dsl.BehaviorSourceMap: [command] :: BehaviorSourceFailure -> !Text

+ Keiro.Dsl.BehaviorSourceMap: [file] :: BehaviorSourceEntry -> !FilePath

+ Keiro.Dsl.BehaviorSourceMap: [key] :: BehaviorSourceEntry -> !BehaviorKey

+ Keiro.Dsl.BehaviorSourceMap: [line] :: BehaviorSourceEntry -> !Int

+ Keiro.Dsl.BehaviorSourceMap: [message] :: BehaviorSourceFailure -> !Text

+ Keiro.Dsl.BehaviorSourceMap: [origin] :: BehaviorSourceFailure -> !RequirementOrigin

+ Keiro.Dsl.BehaviorSourceMap: [sourceSubject] :: BehaviorSourceFailure -> !SourceSubject

+ Keiro.Dsl.BehaviorSourceMap: [span] :: BehaviorSourceFailure -> !Maybe SourceSpan

+ Keiro.Dsl.BehaviorSourceMap: [state] :: BehaviorSourceFailure -> !Text

+ Keiro.Dsl.CheckReport: [code] :: CheckReportEntry -> !DiagnosticCode

+ Keiro.Dsl.CheckReport: [declaredLanguageVersion] :: CheckReportMember -> !Maybe LanguageVersion

+ Keiro.Dsl.CheckReport: [deniedWarnings] :: CheckReportSummary -> !Int

+ Keiro.Dsl.CheckReport: [denied] :: CheckReportEntry -> !Bool

+ Keiro.Dsl.CheckReport: [denyCodes] :: CheckReportEnforcement -> ![DiagnosticCode]

+ Keiro.Dsl.CheckReport: [denyWarnings] :: CheckReportEnforcement -> !Bool

+ Keiro.Dsl.CheckReport: [effectiveLanguageVersion] :: CheckReportLanguage -> !LanguageVersion

+ Keiro.Dsl.CheckReport: [errors] :: CheckReportSummary -> !Int

+ Keiro.Dsl.CheckReport: [file] :: CheckReportEntry -> !FilePath

+ Keiro.Dsl.CheckReport: [languageSupport] :: CheckReportLanguage -> !LanguageSupport

+ Keiro.Dsl.CheckReport: [line] :: CheckReportEntry -> !Int

+ Keiro.Dsl.CheckReport: [message] :: CheckReportEntry -> !Text

+ Keiro.Dsl.CheckReport: [minLanguage] :: CheckReportEnforcement -> !Maybe LanguageVersion

+ Keiro.Dsl.CheckReport: [note] :: CheckReportRelated -> !Text

+ Keiro.Dsl.CheckReport: [path] :: CheckReportMember -> !FilePath

+ Keiro.Dsl.CheckReport: [related] :: CheckReportEntry -> ![CheckReportRelated]

+ Keiro.Dsl.CheckReport: [runtimeSemantics] :: CheckReportLanguage -> !Text

+ Keiro.Dsl.CheckReport: [severity] :: CheckReportEntry -> !Severity

+ Keiro.Dsl.CheckReport: [sourceForm] :: CheckReportMember -> !Text

+ Keiro.Dsl.CheckReport: [stable] :: CheckReportLanguage -> !Bool

+ Keiro.Dsl.CheckReport: [warnings] :: CheckReportSummary -> !Int

+ Keiro.Dsl.CodecCompare: [authority] :: CompareReport -> !Text

+ Keiro.Dsl.CodecCompare: [bindingSymbol] :: CompareProvenance -> !QualifiedValueName

+ Keiro.Dsl.CodecCompare: [bindingVersion] :: CompareProvenance -> !BindingVersion

+ Keiro.Dsl.CodecCompare: [canonicalType] :: CompareProvenance -> !CanonicalTypeId

+ Keiro.Dsl.CodecCompare: [caseName] :: CompareObservation -> !Text

+ Keiro.Dsl.CodecCompare: [coverageGaps] :: CompareReport -> ![CoverageGap]

+ Keiro.Dsl.CodecCompare: [decode] :: HistoricalCodec a -> !Value -> Either Text a

+ Keiro.Dsl.CodecCompare: [encode] :: HistoricalCodec a -> !a -> Value

+ Keiro.Dsl.CodecCompare: [fixturePath] :: CompareObservation -> !FilePath

+ Keiro.Dsl.CodecCompare: [generatedDecode] :: CompareObservation -> !DecodeOutcome

+ Keiro.Dsl.CodecCompare: [generatedValue] :: CompareObservation -> !Value

+ Keiro.Dsl.CodecCompare: [historicalCodecIdentity] :: CompareProvenance -> !Text

+ Keiro.Dsl.CodecCompare: [historicalCodecVersion] :: CompareProvenance -> !Text

+ Keiro.Dsl.CodecCompare: [historicalDecode] :: CompareObservation -> !DecodeOutcome

+ Keiro.Dsl.CodecCompare: [historicalValue] :: CompareObservation -> !Value

+ Keiro.Dsl.CodecCompare: [identity] :: HistoricalCodec a -> !Text

+ Keiro.Dsl.CodecCompare: [inputIssues] :: CompareReport -> ![CompareInputIssue]

+ Keiro.Dsl.CodecCompare: [inputValue] :: CompareObservation -> !Value

+ Keiro.Dsl.CodecCompare: [kind] :: CoverageGap -> !BranchKind

+ Keiro.Dsl.CodecCompare: [message] :: ReportWriteError -> !Text

+ Keiro.Dsl.CodecCompare: [name] :: ClassifiedObservation -> !Text

+ Keiro.Dsl.CodecCompare: [observations] :: CompareReport -> ![ClassifiedObservation]

+ Keiro.Dsl.CodecCompare: [origin] :: ClassifiedObservation -> !FixtureOrigin

+ Keiro.Dsl.CodecCompare: [path] :: ReportWriteError -> !FilePath

+ Keiro.Dsl.CodecCompare: [payloadSchema] :: BranchArm -> !Maybe BranchSchema

+ Keiro.Dsl.CodecCompare: [pointer] :: CoverageGap -> !JsonPointer

+ Keiro.Dsl.CodecCompare: [presenceOptional] :: BranchField -> !Bool

+ Keiro.Dsl.CodecCompare: [provenance] :: CompareReport -> !CompareProvenance

+ Keiro.Dsl.CodecCompare: [schema] :: BranchField -> !BranchSchema

+ Keiro.Dsl.CodecCompare: [verdict] :: ClassifiedObservation -> !FixtureVerdict

+ Keiro.Dsl.CodecCompare: [version] :: HistoricalCodec a -> !Text

+ Keiro.Dsl.CodecCompare: [wireFingerprint] :: CompareProvenance -> !Text

+ Keiro.Dsl.CodecCompare: [wireKey] :: BranchField -> !Text

+ Keiro.Dsl.CodecCompare: [wireTag] :: BranchArm -> !Text

+ Keiro.Dsl.CodecCompare: unJsonPointer :: JsonPointer -> Text

+ Keiro.Dsl.ConformancePackage: [bannerPresent] :: ConformanceStaleFile -> !Maybe Bool

+ Keiro.Dsl.ConformancePackage: [directory] :: ConformancePackagePlan -> !FilePath

+ Keiro.Dsl.ConformancePackage: [dispositions] :: ConformancePackageReport -> ![(ConformanceFile, ConformanceWriteDisposition)]

+ Keiro.Dsl.ConformancePackage: [facadeModule] :: ConformancePackageRecord -> !Text

+ Keiro.Dsl.ConformancePackage: [files] :: ConformancePackageRecord -> ![(ModuleKind, FilePath)]

+ Keiro.Dsl.ConformancePackage: [key] :: DuplicateFactKey -> !String

+ Keiro.Dsl.ConformancePackage: [kind] :: ConformanceStaleFile -> !ModuleKind

+ Keiro.Dsl.ConformancePackage: [packageName] :: ConformancePackagePlan -> !Text

+ Keiro.Dsl.ConformancePackage: [path] :: ConformanceStaleFile -> !FilePath

+ Keiro.Dsl.ConformancePackage: [plan] :: ConformancePackageReport -> !ConformancePackagePlan

+ Keiro.Dsl.ConformancePackage: [root] :: ConformancePackageReport -> !FilePath

+ Keiro.Dsl.ConformancePackage: [runtimePackage] :: ConformancePackageRecord -> !RuntimePackageName

+ Keiro.Dsl.ConformancePackage: [schema] :: ConformancePackageRecord -> !Int

+ Keiro.Dsl.ConformancePackage: [serviceKey] :: ConformancePackageRecord -> !ConformanceServiceKey

+ Keiro.Dsl.ConformancePackage: [side] :: DuplicateFactKey -> !ConformanceFactSide

+ Keiro.Dsl.ConformancePackage: [stale] :: ConformancePackageReport -> ![ConformanceStaleFile]

+ Keiro.Dsl.ConformancePackage: [text] :: ConformanceFile -> !Text

+ Keiro.Dsl.ConsumerTypePlan: unHaskellTypeOccurrence :: HaskellTypeOccurrence -> Text

+ Keiro.Dsl.CoordinationImpact: [currentSelection] :: RouterSelectionDrift -> !Maybe RouterSelectionSnapshot

+ Keiro.Dsl.CoordinationImpact: [fingerprint] :: RouterSelectionSnapshot -> !Maybe Text

+ Keiro.Dsl.CoordinationImpact: [identity] :: RouterSelectionSnapshot -> !Maybe Text

+ Keiro.Dsl.CoordinationImpact: [previousSelection] :: RouterSelectionDrift -> !Maybe RouterSelectionSnapshot

+ Keiro.Dsl.CoordinationImpact: [reason] :: CoordinationImpact -> !CoordinationReason

+ Keiro.Dsl.CoordinationImpact: [router] :: CoordinationImpact -> !Name

+ Keiro.Dsl.CoordinationImpact: [severity] :: CoordinationImpact -> !CoordinationSeverity

+ Keiro.Dsl.CoordinationImpact: [verification] :: RouterSelectionSnapshot -> !SelectionVerification

+ Keiro.Dsl.CoordinationImpact: [version] :: RouterSelectionSnapshot -> !Maybe Natural

+ Keiro.Dsl.Coverage: [aggregate] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [canonicalType] :: StructuralBoundary -> !Text

+ Keiro.Dsl.Coverage: [code] :: CoverageFinding -> !DiagnosticCode

+ Keiro.Dsl.Coverage: [codecIdentity] :: OpaqueBoundary -> !Text

+ Keiro.Dsl.Coverage: [codecVersion] :: OpaqueBoundary -> !Text

+ Keiro.Dsl.Coverage: [consumer] :: CoverageRoot -> !Text

+ Keiro.Dsl.Coverage: [delta] :: CoverageReport -> !Maybe CoverageDelta

+ Keiro.Dsl.Coverage: [enabled] :: SnapshotBoundary -> !Bool

+ Keiro.Dsl.Coverage: [encoding] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [findings] :: CoverageReport -> ![CoverageFinding]

+ Keiro.Dsl.Coverage: [invalidation] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [mappedType] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [message] :: CoverageFinding -> !Text

+ Keiro.Dsl.Coverage: [mode] :: SnapshotBoundary -> !CoverageMode

+ Keiro.Dsl.Coverage: [opaqueBoundaries] :: CoverageReport -> ![OpaqueBoundary]

+ Keiro.Dsl.Coverage: [path] :: JsonBoundary -> !Text

+ Keiro.Dsl.Coverage: [previous] :: CoverageReport -> !Maybe CoveragePrevious

+ Keiro.Dsl.Coverage: [reason] :: UnsupportedSurface -> !Text

+ Keiro.Dsl.Coverage: [reference] :: CoveragePrevious -> !Text

+ Keiro.Dsl.Coverage: [register] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [root] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Coverage: [roots] :: CoverageReport -> ![CoverageRoot]

+ Keiro.Dsl.Coverage: [severity] :: CoverageFinding -> !Severity

+ Keiro.Dsl.Coverage: [snapshotBoundaries] :: CoverageReport -> ![SnapshotBoundary]

+ Keiro.Dsl.Coverage: [spec] :: CoverageReport -> !FilePath

+ Keiro.Dsl.Coverage: [structuralBoundaries] :: CoverageReport -> ![StructuralBoundary]

+ Keiro.Dsl.Coverage: [summary] :: CoverageReport -> !CoverageSummary

+ Keiro.Dsl.Coverage: [support] :: UnsupportedSurface -> !Text

+ Keiro.Dsl.Coverage: [surface] :: UnsupportedSurface -> !Text

+ Keiro.Dsl.Coverage: [unsupportedSurfaces] :: CoverageReport -> ![UnsupportedSurface]

+ Keiro.Dsl.Coverage: [wireFingerprint] :: SnapshotBoundary -> !Text

+ Keiro.Dsl.Diff: [added] :: Paired n -> ![n]

+ Keiro.Dsl.Diff: [code] :: ChangeKind -> !DiagnosticCode

+ Keiro.Dsl.Diff: [consumerBuild] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [context] :: ChangeKind -> !ChangeContext

+ Keiro.Dsl.Diff: [detail] :: ChangeKind -> !Text

+ Keiro.Dsl.Diff: [facet] :: ChangeKind -> !Text

+ Keiro.Dsl.Diff: [mappedConsequences] :: ChangeKind -> !Set MappedConsequence

+ Keiro.Dsl.Diff: [mappedPersistedImpact] :: ChangeKind -> !Maybe MappedPersistedImpact

+ Keiro.Dsl.Diff: [matched] :: Paired n -> ![(n, n)]

+ Keiro.Dsl.Diff: [new] :: DiffEnv -> !Spec

+ Keiro.Dsl.Diff: [node] :: ChangeKind -> !Name

+ Keiro.Dsl.Diff: [oldBinaryReadNewEvents] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [old] :: DiffEnv -> !Spec

+ Keiro.Dsl.Diff: [paths] :: ChangeKind -> ![Text]

+ Keiro.Dsl.Diff: [persistedIdentity] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [privateHistoryRead] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [publicConsumer] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [removed] :: Paired n -> ![n]

+ Keiro.Dsl.Diff: [rollout] :: CompatibilityVector -> !Set RolloutConstraint

+ Keiro.Dsl.Diff: [snapshotHydration] :: CompatibilityVector -> !SurfaceVerdict

+ Keiro.Dsl.Diff: [subject] :: ChangeKind -> !Text

+ Keiro.Dsl.Diff: [surface] :: MappedPersistedImpact -> !MappedPersistedSurface

+ Keiro.Dsl.Diff: [vector] :: ChangeKind -> !CompatibilityVector

+ Keiro.Dsl.Diff: [verdict] :: MappedPersistedImpact -> !SurfaceVerdict

+ Keiro.Dsl.DiffReport: [adoptionBaseline] :: WorkspaceMeta -> !Bool

+ Keiro.Dsl.DiffReport: [change] :: WorkspaceChange -> !Change

+ Keiro.Dsl.DiffReport: [declarationSite] :: WorkspaceChange -> !Maybe OwnedSite

+ Keiro.Dsl.DiffReport: [file] :: OwnedSite -> !FilePath

+ Keiro.Dsl.DiffReport: [identity] :: WorkspaceMeta -> !Text

+ Keiro.Dsl.DiffReport: [line] :: OwnedSite -> !Int

+ Keiro.Dsl.DiffReport: [manifest] :: WorkspaceMeta -> !FilePath

+ Keiro.Dsl.DiffReport: [membersNew] :: WorkspaceMeta -> ![FilePath]

+ Keiro.Dsl.DiffReport: [membersOld] :: WorkspaceMeta -> ![FilePath]

+ Keiro.Dsl.DiffReport: [since] :: WorkspaceMeta -> !Text

+ Keiro.Dsl.DiffReport: [useSites] :: WorkspaceChange -> ![(Text, Maybe OwnedSite)]

+ Keiro.Dsl.EventOutput: [fields] :: EventOutputMapping -> ![CheckedFieldCopy]

+ Keiro.Dsl.EventOutput: [obligation] :: EventOutputMapping -> !OutputObligationKey

+ Keiro.Dsl.EventOutput: [sourceCommand] :: EventOutputMapping -> !Name

+ Keiro.Dsl.EventOutput: unOutputObligationKey :: OutputObligationKey -> Text

+ Keiro.Dsl.ExplainBindings: [bindingVersion] :: BindingObligation -> !Maybe Text

+ Keiro.Dsl.ExplainBindings: [canonicalType] :: BindingObligation -> !Maybe Text

+ Keiro.Dsl.ExplainBindings: [category] :: BindingObligation -> !Text

+ Keiro.Dsl.ExplainBindings: [equalityContract] :: BindingObligation -> !Maybe Text

+ Keiro.Dsl.ExplainBindings: [idDomainContract] :: BindingObligation -> !Maybe Text

+ Keiro.Dsl.ExplainBindings: [kind] :: BindingHole -> !BindingObligationKind

+ Keiro.Dsl.ExplainBindings: [mappedName] :: BindingHole -> !Name

+ Keiro.Dsl.ExplainBindings: [moduleName] :: BindingHole -> !Text

+ Keiro.Dsl.ExplainBindings: [package] :: BindingObligation -> !Text

+ Keiro.Dsl.ExplainBindings: [path] :: BindingHole -> !Maybe Text

+ Keiro.Dsl.ExplainBindings: [signature] :: BindingHole -> !Text

+ Keiro.Dsl.ExplainBindings: [symbol] :: BindingHole -> !Text

+ Keiro.Dsl.ExplainBindings: [useSites] :: BindingObligation -> ![Text]

+ Keiro.Dsl.Expression: [code] :: ExpressionDiagnostic -> !ExpressionDiagnosticCode

+ Keiro.Dsl.Expression: [fields] :: ResolvedScalarProjection -> ![Name]

+ Keiro.Dsl.Expression: [loc] :: ExpressionDiagnostic -> !Loc

+ Keiro.Dsl.Expression: [message] :: ExpressionDiagnostic -> !Text

+ Keiro.Dsl.Expression: [node] :: TypedScalarExpr -> !TypedScalarNode

+ Keiro.Dsl.Expression: [owner] :: ResolvedScalarProjection -> !MappedKey

+ Keiro.Dsl.Expression: [pointer] :: ResolvedScalarProjection -> !Text

+ Keiro.Dsl.Expression: [valueType] :: TypedScalarExpr -> !ResolvedAggregateType

+ Keiro.Dsl.Goldens: [aggregate] :: GoldenPayload -> !Text

+ Keiro.Dsl.Goldens: [context] :: GoldenPayload -> !Text

+ Keiro.Dsl.Goldens: [event] :: GoldenPayload -> !Text

+ Keiro.Dsl.Goldens: [evidence] :: GoldenPayload -> !GoldenEvidence

+ Keiro.Dsl.Goldens: [json] :: GoldenPayload -> !Text

+ Keiro.Dsl.Goldens: [version] :: GoldenPayload -> !Int

+ Keiro.Dsl.Grammar: [accept] :: IntakeNode -> ![Name]

+ Keiro.Dsl.Grammar: [action] :: WqDispRow -> !InboxAction

+ Keiro.Dsl.Grammar: [advance] :: HandleNode -> !AdvanceNode

+ Keiro.Dsl.Grammar: [agg] :: SagaRef -> !Name

+ Keiro.Dsl.Grammar: [backingTarget] :: ReadModelNode -> !Maybe Name

+ Keiro.Dsl.Grammar: [backoff] :: PublisherNode -> !BackoffSpec

+ Keiro.Dsl.Grammar: [bindingVersion] :: NominalBindingDecl -> !Maybe Text

+ Keiro.Dsl.Grammar: [binding] :: NominalScalarDecl -> !NominalBindingDecl

+ Keiro.Dsl.Grammar: [binds] :: IntakeNode -> ![BindRow]

+ Keiro.Dsl.Grammar: [bodySchemaVersion] :: DecodeSpec -> !Int

+ Keiro.Dsl.Grammar: [bodyStrict] :: DecodeSpec -> !Bool

+ Keiro.Dsl.Grammar: [body] :: WorkflowNode -> ![WfBodyItem]

+ Keiro.Dsl.Grammar: [canonicalName] :: PromotionObjectNode -> !Text

+ Keiro.Dsl.Grammar: [canonicalType] :: NominalBindingDecl -> !Maybe Text

+ Keiro.Dsl.Grammar: [cases] :: RuleDecl -> ![(Name, Expr)]

+ Keiro.Dsl.Grammar: [category] :: SagaRef -> !Text

+ Keiro.Dsl.Grammar: [checkpointOnMissing] :: ProjectionOwnerNode -> ![CheckpointOnMissingNode]

+ Keiro.Dsl.Grammar: [codecVersion] :: SnapshotSpec -> !Int

+ Keiro.Dsl.Grammar: [codomain] :: RuleDecl -> !Name

+ Keiro.Dsl.Grammar: [columns] :: ReadModelNode -> ![RmColumn]

+ Keiro.Dsl.Grammar: [command] :: RouterDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [commands] :: Aggregate -> ![Command]

+ Keiro.Dsl.Grammar: [compatibleRevisions] :: ExternalReadNode -> ![Name]

+ Keiro.Dsl.Grammar: [consistency] :: ProjectionSpec -> !Maybe Consistency

+ Keiro.Dsl.Grammar: [contentsField] :: UnionEncoding -> !Text

+ Keiro.Dsl.Grammar: [context] :: Spec -> !Name

+ Keiro.Dsl.Grammar: [contract] :: EmitNode -> !Name

+ Keiro.Dsl.Grammar: [correlate] :: ProcessNode -> !CorrelateDecl

+ Keiro.Dsl.Grammar: [crossCheck] :: BindRow -> !Bool

+ Keiro.Dsl.Grammar: [ctor] :: WireArm -> !Name

+ Keiro.Dsl.Grammar: [ctors] :: EnumDecl -> ![(Name, Text)]

+ Keiro.Dsl.Grammar: [deadLetter] :: TimerNode -> !Text

+ Keiro.Dsl.Grammar: [decodeUnknown] :: TimerNode -> !Name

+ Keiro.Dsl.Grammar: [decode] :: IntakeNode -> !DecodeSpec

+ Keiro.Dsl.Grammar: [dedupKey] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [dedupQueueField] :: PgmqDispatchNode -> !Text

+ Keiro.Dsl.Grammar: [dedupQueue] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [dedupReadModelField] :: PgmqDispatchNode -> !Text

+ Keiro.Dsl.Grammar: [dedupReadModel] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [dedup] :: ProjectionOwnerNode -> !Maybe Text

+ Keiro.Dsl.Grammar: [dedupeKey] :: IntakeNode -> !Name

+ Keiro.Dsl.Grammar: [dedupeLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [dedupePolicy] :: IntakeNode -> !Name

+ Keiro.Dsl.Grammar: [dedupe] :: RouterSelectionDecl -> !Name

+ Keiro.Dsl.Grammar: [delay] :: WorkqueueNode -> !Text

+ Keiro.Dsl.Grammar: [delivery] :: ProjectionOwnerNode -> !ProjectionDelivery

+ Keiro.Dsl.Grammar: [dependsOn] :: ProjectionTargetNode -> ![Name]

+ Keiro.Dsl.Grammar: [deprecated] :: Event -> !Bool

+ Keiro.Dsl.Grammar: [discriminant] :: EmitNode -> !Name

+ Keiro.Dsl.Grammar: [discriminator] :: ContractNode -> !Name

+ Keiro.Dsl.Grammar: [dispatch] :: RouterNode -> !RouterDispatchNode

+ Keiro.Dsl.Grammar: [disposition] :: WorkqueueNode -> ![WqDispRow]

+ Keiro.Dsl.Grammar: [dlqOn] :: WorkqueueNode -> !Bool

+ Keiro.Dsl.Grammar: [dlq] :: WorkqueueNode -> !Text

+ Keiro.Dsl.Grammar: [domainOutcomeDuplicateLocs] :: Aggregate -> ![Loc]

+ Keiro.Dsl.Grammar: [domainOutcomeTypes] :: Aggregate -> !Maybe DomainOutcomeTypes

+ Keiro.Dsl.Grammar: [domain] :: RuleDecl -> !Name

+ Keiro.Dsl.Grammar: [emit] :: PublisherNode -> !Name

+ Keiro.Dsl.Grammar: [emits] :: Transition -> ![Name]

+ Keiro.Dsl.Grammar: [emptyPolicyLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [emptyPolicy] :: RouterSelectionDecl -> !SelectionDispositionSyntax

+ Keiro.Dsl.Grammar: [enqueueTo] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [enums] :: Spec -> ![EnumDecl]

+ Keiro.Dsl.Grammar: [envelope] :: DecodeSpec -> !Text

+ Keiro.Dsl.Grammar: [event] :: EmitMapRow -> !Name

+ Keiro.Dsl.Grammar: [events] :: ContractNode -> ![ContractEvent]

+ Keiro.Dsl.Grammar: [expectedShape] :: RevisionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [failurePolicyLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [failurePolicy] :: RouterSelectionDecl -> !SelectionDispositionSyntax

+ Keiro.Dsl.Grammar: [fanoutBody] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [field] :: WqGroupKey -> !Name

+ Keiro.Dsl.Grammar: [fields] :: ContractEvent -> ![ContractField]

+ Keiro.Dsl.Grammar: [fireAt] :: TimerNode -> !FireAtExpr

+ Keiro.Dsl.Grammar: [fire] :: TimerNode -> !FireNode

+ Keiro.Dsl.Grammar: [firedEventId] :: FireNode -> !IdExpr

+ Keiro.Dsl.Grammar: [fixture] :: WqGroupKey -> !Maybe Text

+ Keiro.Dsl.Grammar: [fixtures] :: NominalBindingDecl -> !Maybe Text

+ Keiro.Dsl.Grammar: [freshness] :: ReadModelNode -> !QueryFreshnessNode

+ Keiro.Dsl.Grammar: [generationName] :: PromotionObjectNode -> !Text

+ Keiro.Dsl.Grammar: [goto] :: Transition -> !Name

+ Keiro.Dsl.Grammar: [groupKey] :: WorkqueueNode -> !Maybe WqGroupKey

+ Keiro.Dsl.Grammar: [group] :: ProjectionOwnerNode -> !Name

+ Keiro.Dsl.Grammar: [guard] :: Transition -> !Maybe Expr

+ Keiro.Dsl.Grammar: [handle] :: ProcessNode -> !HandleNode

+ Keiro.Dsl.Grammar: [haskell] :: NominalBindingDecl -> !Maybe HaskellSource

+ Keiro.Dsl.Grammar: [idField] :: WorkflowNode -> !Maybe Name

+ Keiro.Dsl.Grammar: [idVia] :: WorkflowNode -> !Name

+ Keiro.Dsl.Grammar: [id] :: WorkflowNode -> !Name

+ Keiro.Dsl.Grammar: [idempotencyKey] :: EmitNode -> !DeriveSpec

+ Keiro.Dsl.Grammar: [identityLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [identity] :: RouterSelectionDecl -> !Text

+ Keiro.Dsl.Grammar: [ids] :: Spec -> ![IdDecl]

+ Keiro.Dsl.Grammar: [implementation] :: Transition -> !TransitionImplementation

+ Keiro.Dsl.Grammar: [initial] :: RegDecl -> !RegInitial

+ Keiro.Dsl.Grammar: [inputFields] :: WorkflowNode -> ![Field]

+ Keiro.Dsl.Grammar: [key] :: EmitNode -> !Name

+ Keiro.Dsl.Grammar: [kind] :: PromotionObjectNode -> !PromotionObjectKindNode

+ Keiro.Dsl.Grammar: [layout] :: Spec -> !Maybe Placement

+ Keiro.Dsl.Grammar: [limit] :: RouterSelectionDecl -> !Maybe (Natural, Loc)

+ Keiro.Dsl.Grammar: [loc] :: OperationNode -> !Loc

+ Keiro.Dsl.Grammar: [logical] :: WorkqueueNode -> !Text

+ Keiro.Dsl.Grammar: [map] :: EmitNode -> ![EmitMapRow]

+ Keiro.Dsl.Grammar: [mapped] :: Spec -> ![MappedDecl]

+ Keiro.Dsl.Grammar: [maxAttempts] :: PublisherNode -> !Int

+ Keiro.Dsl.Grammar: [maxRetries] :: WorkqueueNode -> !Int

+ Keiro.Dsl.Grammar: [max] :: BackoffSpec -> !Maybe Text

+ Keiro.Dsl.Grammar: [messageId] :: EmitNode -> !DeriveSpec

+ Keiro.Dsl.Grammar: [mode] :: Transition -> !TransitionMode

+ Keiro.Dsl.Grammar: [moduleName] :: HaskellSource -> !Text

+ Keiro.Dsl.Grammar: [moduleRoot] :: Spec -> !Maybe Text

+ Keiro.Dsl.Grammar: [multiplier] :: BackoffSpec -> !Maybe Text

+ Keiro.Dsl.Grammar: [name] :: OperationNode -> !Name

+ Keiro.Dsl.Grammar: [nodes] :: Spec -> ![Node]

+ Keiro.Dsl.Grammar: [nominalScalars] :: Spec -> ![NominalScalarDecl]

+ Keiro.Dsl.Grammar: [observedTargets] :: ReadModelNode -> ![Name]

+ Keiro.Dsl.Grammar: [onMissing] :: WireField -> !Maybe OnMissing

+ Keiro.Dsl.Grammar: [on] :: HandleNode -> !Name

+ Keiro.Dsl.Grammar: [orderLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [order] :: ProjectionOwnerNode -> !Int

+ Keiro.Dsl.Grammar: [ordering] :: WorkqueueNode -> !WqOrdering

+ Keiro.Dsl.Grammar: [outboxField] :: PublisherNode -> !Name

+ Keiro.Dsl.Grammar: [outcomeDuplicateLocs] :: Transition -> ![Loc]

+ Keiro.Dsl.Grammar: [outcome] :: WqDispRow -> !Name

+ Keiro.Dsl.Grammar: [output] :: WorkflowNode -> !Name

+ Keiro.Dsl.Grammar: [package] :: HaskellSource -> !Text

+ Keiro.Dsl.Grammar: [pairs] :: Mapping -> ![(Name, Name)]

+ Keiro.Dsl.Grammar: [partialLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [partial] :: RouterSelectionDecl -> !Name

+ Keiro.Dsl.Grammar: [payloadName] :: WorkqueueNode -> !Name

+ Keiro.Dsl.Grammar: [payload] :: WorkqueueNode -> ![WqField]

+ Keiro.Dsl.Grammar: [persist] :: IntakeNode -> !InkPersist

+ Keiro.Dsl.Grammar: [physical] :: WorkqueueNode -> !Text

+ Keiro.Dsl.Grammar: [poison] :: RouterNode -> !PolicyChoice

+ Keiro.Dsl.Grammar: [policy] :: SnapshotSpec -> !SnapPolicy

+ Keiro.Dsl.Grammar: [predicate] :: RouterSelectionDecl -> !Expr

+ Keiro.Dsl.Grammar: [prefix] :: IdExpr -> !Text

+ Keiro.Dsl.Grammar: [presence] :: WireField -> !Presence

+ Keiro.Dsl.Grammar: [projection] :: Aggregate -> !Maybe ProjectionSpec

+ Keiro.Dsl.Grammar: [projections] :: RouterNode -> ![Name]

+ Keiro.Dsl.Grammar: [promotionObjects] :: RevisionTargetNode -> ![PromotionObjectNode]

+ Keiro.Dsl.Grammar: [provision] :: WorkqueueNode -> !WqProvision

+ Keiro.Dsl.Grammar: [provisionerVersion] :: RevisionTargetNode -> !Int

+ Keiro.Dsl.Grammar: [provisioner] :: RevisionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [queryInputLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [queryInput] :: RouterSelectionDecl -> !Name

+ Keiro.Dsl.Grammar: [queryLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [queryModel] :: ExternalReadNode -> !Name

+ Keiro.Dsl.Grammar: [query] :: RouterSelectionDecl -> !Name

+ Keiro.Dsl.Grammar: [recipient] :: RouterSelectionDecl -> !Expr

+ Keiro.Dsl.Grammar: [redeliveryLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [redelivery] :: RouterSelectionDecl -> !Name

+ Keiro.Dsl.Grammar: [regs] :: Aggregate -> ![RegDecl]

+ Keiro.Dsl.Grammar: [rejected] :: RouterNode -> !PolicyChoice

+ Keiro.Dsl.Grammar: [replay] :: ProjectionOwnerNode -> !ProjectionReplayPolicy

+ Keiro.Dsl.Grammar: [representation] :: NominalScalarDecl -> !Name

+ Keiro.Dsl.Grammar: [required] :: BindRow -> !Bool

+ Keiro.Dsl.Grammar: [reset] :: ProjectionTargetNode -> !TargetResetPolicy

+ Keiro.Dsl.Grammar: [resolve] :: RouterNode -> !ResolveDecl

+ Keiro.Dsl.Grammar: [resultSchema] :: ExternalReadNode -> !Text

+ Keiro.Dsl.Grammar: [resultType] :: ExternalReadNode -> !Text

+ Keiro.Dsl.Grammar: [retiring] :: Event -> !Bool

+ Keiro.Dsl.Grammar: [row] :: ResolveDecl -> ![Name]

+ Keiro.Dsl.Grammar: [rules] :: Spec -> ![RuleDecl]

+ Keiro.Dsl.Grammar: [saga] :: ProcessNode -> !SagaRef

+ Keiro.Dsl.Grammar: [schedule] :: HandleNode -> !Name

+ Keiro.Dsl.Grammar: [schemaVersion] :: RevisionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [schema] :: ProjectionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [selector] :: ContractField -> !Maybe Name

+ Keiro.Dsl.Grammar: [shapeHash] :: SnapshotSpec -> !Text

+ Keiro.Dsl.Grammar: [shape] :: OperationNode -> !OperationShape

+ Keiro.Dsl.Grammar: [skip] :: EmitNode -> !Bool

+ Keiro.Dsl.Grammar: [snapshot] :: Aggregate -> !Maybe SnapshotSpec

+ Keiro.Dsl.Grammar: [sourceKey] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [sourceReadModel] :: PgmqDispatchNode -> !Name

+ Keiro.Dsl.Grammar: [source] :: EmitNode -> !Text

+ Keiro.Dsl.Grammar: [sources] :: ProjectionOwnerNode -> ![CatalogSource]

+ Keiro.Dsl.Grammar: [stable] :: WorkflowNode -> !Text

+ Keiro.Dsl.Grammar: [states] :: Aggregate -> ![StateDecl]

+ Keiro.Dsl.Grammar: [statusMap] :: ProjectionSpec -> !Maybe Mapping

+ Keiro.Dsl.Grammar: [strategy] :: IdExpr -> !IdStrategy

+ Keiro.Dsl.Grammar: [subscription] :: ProjectionOwnerNode -> !Maybe Text

+ Keiro.Dsl.Grammar: [supply] :: ReadModelNode -> !ReadModelSupply

+ Keiro.Dsl.Grammar: [surfaceGeneration] :: ExternalReadNode -> !Int

+ Keiro.Dsl.Grammar: [table] :: ProjectionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [tagField] :: UnionEncoding -> !Text

+ Keiro.Dsl.Grammar: [tag] :: WireArm -> !Text

+ Keiro.Dsl.Grammar: [target] :: RevisionTargetNode -> !Name

+ Keiro.Dsl.Grammar: [targets] :: ProjectionOwnerNode -> ![Name]

+ Keiro.Dsl.Grammar: [terminal] :: StateDecl -> !Bool

+ Keiro.Dsl.Grammar: [timer] :: ProcessNode -> !TimerNode

+ Keiro.Dsl.Grammar: [topic] :: EmitNode -> !Name

+ Keiro.Dsl.Grammar: [topics] :: ContractNode -> ![(Name, Text)]

+ Keiro.Dsl.Grammar: [transitions] :: Aggregate -> ![Transition]

+ Keiro.Dsl.Grammar: [unknownFields] :: UnionEncoding -> !UnknownFields

+ Keiro.Dsl.Grammar: [upcastFrom] :: Event -> !Maybe (Int, Hole)

+ Keiro.Dsl.Grammar: [validatorVersion] :: RevisionTargetNode -> !Int

+ Keiro.Dsl.Grammar: [validator] :: RevisionTargetNode -> !Text

+ Keiro.Dsl.Grammar: [valueType] :: WqField -> !QueuePayloadType

+ Keiro.Dsl.Grammar: [value] :: EmitMapRow -> !Text

+ Keiro.Dsl.Grammar: [versionLoc] :: RouterSelectionDecl -> !Loc

+ Keiro.Dsl.Grammar: [version] :: ExternalReadNode -> !Int

+ Keiro.Dsl.Grammar: [via] :: WqGroupKey -> !Name

+ Keiro.Dsl.Grammar: [window] :: BackoffSpec -> !Text

+ Keiro.Dsl.Grammar: [wireKey] :: ContractField -> !Maybe Text

+ Keiro.Dsl.Grammar: [wire] :: WqField -> !Text

+ Keiro.Dsl.Grammar: [writes] :: Transition -> ![(Name, Expr)]

+ Keiro.Dsl.Grammar: unLoc :: Loc -> Int

+ Keiro.Dsl.HaskellImport: [moduleName] :: HaskellReference -> !Text

+ Keiro.Dsl.HaskellImport: [name] :: HaskellReference -> !Text

+ Keiro.Dsl.HaskellImport: [namespace] :: HaskellReference -> !HaskellNamespace

+ Keiro.Dsl.HaskellImport: [qualification] :: HaskellReference -> !QualificationPreference

+ Keiro.Dsl.HaskellSourceMove: [backupPath] :: SourceMove -> !FilePath

+ Keiro.Dsl.HaskellSourceMove: [contentDigest] :: SourceMove -> !Maybe Text

+ Keiro.Dsl.HaskellSourceMove: [kind] :: SourceMove -> !ModuleKind

+ Keiro.Dsl.HaskellSourceMove: [newModule] :: SourceMove -> !Text

+ Keiro.Dsl.HaskellSourceMove: [newPath] :: SourceMove -> !FilePath

+ Keiro.Dsl.HaskellSourceMove: [oldModule] :: SourceMove -> !Text

+ Keiro.Dsl.HaskellSourceMove: [oldPath] :: SourceMove -> !FilePath

+ Keiro.Dsl.HaskellSourceMove: [role] :: SourceMove -> !ModuleRole

+ Keiro.Dsl.HaskellSourceMove: [transformedDigest] :: SourceMove -> !Maybe Text

+ Keiro.Dsl.LanguageVersion: [bodyParser] :: LanguageDefinition -> !LanguageBodyParser

+ Keiro.Dsl.LanguageVersion: [declaredVersion] :: SourceLanguageDiagnostic -> !Maybe LanguageVersion

+ Keiro.Dsl.LanguageVersion: [errorCode] :: SourceLanguageDiagnostic -> !SourceLanguageErrorCode

+ Keiro.Dsl.LanguageVersion: [loc] :: SourceLanguageDiagnostic -> !Loc

+ Keiro.Dsl.LanguageVersion: [maturity] :: LanguageDefinition -> !LanguageMaturity

+ Keiro.Dsl.LanguageVersion: [predecessor] :: LanguageDefinition -> !Maybe LanguageVersion

+ Keiro.Dsl.LanguageVersion: [runtimeSemanticsProfile] :: LanguageDefinition -> !RuntimeSemanticsProfile

+ Keiro.Dsl.LanguageVersion: [sourceLanguage] :: ParsedSource -> !SourceLanguage

+ Keiro.Dsl.LanguageVersion: [source] :: SourceLanguageDiagnostic -> !FilePath

+ Keiro.Dsl.LanguageVersion: [spec] :: ParsedSource -> !Spec

+ Keiro.Dsl.LanguageVersion: [support] :: LanguageDefinition -> !LanguageSupport

+ Keiro.Dsl.LanguageVersion: [supportedVersions] :: SourceLanguageDiagnostic -> !NonEmpty LanguageVersion

+ Keiro.Dsl.LanguageVersion: [syntaxProfile] :: LanguageDefinition -> !SyntaxProfile

+ Keiro.Dsl.LanguageVersion: [token] :: SourceLanguageDiagnostic -> !Maybe Text

+ Keiro.Dsl.LanguageVersion: [version] :: LanguageDefinition -> !LanguageVersion

+ Keiro.Dsl.MappedConsumer: [bindingSymbol] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [bindingVersion] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [canonicalType] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [codecIdentity] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [codecVersion] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [fixtureSymbol] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [initialSymbol] :: MappingIdentity -> !Maybe Text

+ Keiro.Dsl.MappedConsumer: [mappings] :: ConsumerPlan -> ![MappingIdentity]

+ Keiro.Dsl.MappedConsumer: [moduleName] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [modules] :: ConsumerPlan -> ![Text]

+ Keiro.Dsl.MappedConsumer: [nominalCategory] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [nominalRepresentation] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [package] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [packages] :: ConsumerPlan -> ![Text]

+ Keiro.Dsl.MappedConsumer: [specName] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedConsumer: [valueType] :: MappingIdentity -> !Text

+ Keiro.Dsl.MappedDiff: [code] :: MappedFinding -> !DiagnosticCode

+ Keiro.Dsl.MappedDiff: [declaration] :: MappedFinding -> !Name

+ Keiro.Dsl.MappedDiff: [detail] :: MappedFinding -> !Text

+ Keiro.Dsl.MappedDiff: [leaf] :: MappedFinding -> !Text

+ Keiro.Dsl.MappedDiff: [oldUnknownFields] :: MappedFinding -> !Maybe UnknownFields

+ Keiro.Dsl.MappedDiff: [usePaths] :: MappedFinding -> ![UsePath]

+ Keiro.Dsl.NominalType: [bindingVersion] :: ConsumerNominalBinding -> !BindingVersion

+ Keiro.Dsl.NominalType: [binding] :: ConsumerNominalBinding -> !QualifiedValueName

+ Keiro.Dsl.NominalType: [canonical] :: ConsumerNominalBinding -> !CanonicalTypeId

+ Keiro.Dsl.NominalType: [contractVersion] :: CheckedNominalEquality -> !Text

+ Keiro.Dsl.NominalType: [domain] :: CheckedNominalEquality -> !NominalEqualityDomain

+ Keiro.Dsl.NominalType: [fixtures] :: ConsumerNominalBinding -> !QualifiedValueName

+ Keiro.Dsl.NominalType: [haskell] :: ConsumerNominalBinding -> !HaskellSource

+ Keiro.Dsl.NominalType: [initial] :: ConsumerNominalBinding -> !Maybe QualifiedValueName

+ Keiro.Dsl.NominalType: [keyRepresentation] :: CheckedNominalEquality -> !NominalEqualityKey

+ Keiro.Dsl.NominalType: [loc] :: ResolvedNominalType -> !Loc

+ Keiro.Dsl.NominalType: [name] :: ResolvedNominalType -> !Name

+ Keiro.Dsl.NominalType: [ownership] :: ResolvedNominalType -> !NominalOwnership

+ Keiro.Dsl.NominalType: [representation] :: ResolvedNominalType -> !NominalRepresentation

+ Keiro.Dsl.Parser: [parsedSource] :: ParsedSourceDocument -> !ParsedSource

+ Keiro.Dsl.Parser: [sourceIndex] :: ParsedSourceDocument -> !SemanticSourceIndex

+ Keiro.Dsl.Parser: [sourceLanguage] :: ParsedSource -> !SourceLanguage

+ Keiro.Dsl.Parser: [spec] :: ParsedSource -> !Spec

+ Keiro.Dsl.ProjectionSupply: [observedTargets] :: ResolvedProjectionSupply -> !NonEmpty Name

+ Keiro.Dsl.ProjectionSupply: [ownerLoc] :: ResolvedProjectionSupply -> !Loc

+ Keiro.Dsl.ProjectionSupply: [projectionOwner] :: ResolvedProjectionSupply -> !Name

+ Keiro.Dsl.ProjectionSupply: [queryLoc] :: ResolvedProjectionSupply -> !Loc

+ Keiro.Dsl.ProjectionSupply: [queryModel] :: ResolvedProjectionSupply -> !Name

+ Keiro.Dsl.ProjectionSupply: [rebuildGroup] :: ResolvedProjectionSupply -> !Name

+ Keiro.Dsl.ReadModelQueryContract: [current] :: QueryContractDrift -> !Maybe QueryContractIdentity

+ Keiro.Dsl.ReadModelQueryContract: [key] :: QueryContractDrift -> !(Name, QueryContractPosition)

+ Keiro.Dsl.ReadModelQueryContract: [mappedDependencies] :: QueryContractIdentity -> ![Name]

+ Keiro.Dsl.ReadModelQueryContract: [position] :: QueryContractIdentity -> !QueryContractPosition

+ Keiro.Dsl.ReadModelQueryContract: [previous] :: QueryContractDrift -> !Maybe QueryContractIdentity

+ Keiro.Dsl.ReadModelQueryContract: [readModel] :: QueryContractIdentity -> !Name

+ Keiro.Dsl.ReadModelQueryContract: [typeExpression] :: QueryContractIdentity -> !Text

+ Keiro.Dsl.RouterSelection: [code] :: RouterSelectionDiagnostic -> !RouterSelectionDiagnosticCode

+ Keiro.Dsl.RouterSelection: [commandFields] :: CheckedRouterSelection -> !Map Name CheckedScalarExpr

+ Keiro.Dsl.RouterSelection: [command] :: CheckedRouterSelection -> !Name

+ Keiro.Dsl.RouterSelection: [constructor] :: CheckedMappedType -> !Name

+ Keiro.Dsl.RouterSelection: [dedupe] :: CheckedRouterSelection -> !CheckedSelectionDedupe

+ Keiro.Dsl.RouterSelection: [emptyPolicy] :: CheckedRouterSelection -> !CheckedEmptySelectionPolicy

+ Keiro.Dsl.RouterSelection: [failurePolicy] :: CheckedRouterSelection -> !CheckedSelectionFailurePolicy

+ Keiro.Dsl.RouterSelection: [field] :: CheckedSelectionPathSegment -> !Name

+ Keiro.Dsl.RouterSelection: [fields] :: CheckedMappedType -> ![ResolvedWireField]

+ Keiro.Dsl.RouterSelection: [fingerprint] :: CheckedRouterSelection -> !Text

+ Keiro.Dsl.RouterSelection: [identity] :: CheckedRouterSelection -> !Text

+ Keiro.Dsl.RouterSelection: [inputBinding] :: CheckedRouterSelection -> !CheckedMappedExpr

+ Keiro.Dsl.RouterSelection: [inputType] :: CheckedReadModelQuery -> !ResolvedTypeExpr

+ Keiro.Dsl.RouterSelection: [key] :: CheckedRouterSelection -> !CheckedScalarExpr

+ Keiro.Dsl.RouterSelection: [limit] :: CheckedRouterSelection -> !Natural

+ Keiro.Dsl.RouterSelection: [loc] :: RouterSelectionDiagnostic -> !Loc

+ Keiro.Dsl.RouterSelection: [message] :: RouterSelectionDiagnostic -> !Text

+ Keiro.Dsl.RouterSelection: [name] :: CheckedReadModelQuery -> !Name

+ Keiro.Dsl.RouterSelection: [node] :: CheckedScalarExpr -> !CheckedScalarNode

+ Keiro.Dsl.RouterSelection: [order] :: CheckedRouterSelection -> !CheckedSelectionOrder

+ Keiro.Dsl.RouterSelection: [owner] :: CheckedSelectionPathSegment -> !MappedKey

+ Keiro.Dsl.RouterSelection: [partialPolicy] :: CheckedRouterSelection -> !CheckedPartialDispatchPolicy

+ Keiro.Dsl.RouterSelection: [predicate] :: CheckedRouterSelection -> !CheckedScalarExpr

+ Keiro.Dsl.RouterSelection: [query] :: CheckedRouterSelection -> !CheckedReadModelQuery

+ Keiro.Dsl.RouterSelection: [recipient] :: CheckedRouterSelection -> !CheckedScalarExpr

+ Keiro.Dsl.RouterSelection: [redeliveryPolicy] :: CheckedRouterSelection -> !CheckedRedeliveryPolicy

+ Keiro.Dsl.RouterSelection: [resultType] :: CheckedReadModelQuery -> !ResolvedTypeExpr

+ Keiro.Dsl.RouterSelection: [root] :: CheckedMappedExpr -> !SelectionRoot

+ Keiro.Dsl.RouterSelection: [rowBinding] :: CheckedRouterSelection -> !CheckedMappedType

+ Keiro.Dsl.RouterSelection: [target] :: CheckedRouterSelection -> !Name

+ Keiro.Dsl.RouterSelection: [useSites] :: CheckedRouterSelection -> ![UseSite]

+ Keiro.Dsl.RouterSelection: [valueType] :: CheckedScalarExpr -> !SelectionScalarType

+ Keiro.Dsl.RouterSelection: [version] :: CheckedRouterSelection -> !Natural

+ Keiro.Dsl.RouterSelection: [wireKey] :: CheckedSelectionPathSegment -> !Text

+ Keiro.Dsl.RuntimePackage: unRuntimePackageName :: RuntimePackageName -> Text

+ Keiro.Dsl.Scaffold: [aggregate] :: Agg -> !Aggregate

+ Keiro.Dsl.Scaffold: [binding] :: StructuralProjection -> !QualifiedValueName

+ Keiro.Dsl.Scaffold: [canonical] :: StructuralProjection -> !CanonicalTypeId

+ Keiro.Dsl.Scaffold: [checkedService] :: Agg -> !CheckedService

+ Keiro.Dsl.Scaffold: [commands] :: Agg -> ![ResolvedCtor]

+ Keiro.Dsl.Scaffold: [context] :: Agg -> !Context

+ Keiro.Dsl.Scaffold: [ctxPascal] :: Agg -> !Text

+ Keiro.Dsl.Scaffold: [declaration] :: NominalGenerationOwner -> !ResolvedNominalType

+ Keiro.Dsl.Scaffold: [domainOutcomeTypes] :: Agg -> !Maybe ResolvedDomainOutcomeTypes

+ Keiro.Dsl.Scaffold: [enums] :: Agg -> ![EnumDecl]

+ Keiro.Dsl.Scaffold: [equalityUsed] :: NominalGenerationOwner -> !Bool

+ Keiro.Dsl.Scaffold: [events] :: Agg -> ![ResolvedCtor]

+ Keiro.Dsl.Scaffold: [family] :: ModuleRole -> !Text

+ Keiro.Dsl.Scaffold: [fields] :: ResolvedCtor -> ![(ResolvedFieldIdentity, ResolvedAggregateType)]

+ Keiro.Dsl.Scaffold: [foldFingerprint] :: Agg -> !Text

+ Keiro.Dsl.Scaffold: [genPrefix] :: Agg -> !Text

+ Keiro.Dsl.Scaffold: [generatedNominals] :: Agg -> ![ResolvedNominalType]

+ Keiro.Dsl.Scaffold: [holePrefix] :: Agg -> !Text

+ Keiro.Dsl.Scaffold: [ids] :: Agg -> ![IdDecl]

+ Keiro.Dsl.Scaffold: [initial] :: ResolvedRegister -> !ResolvedRegisterInitial

+ Keiro.Dsl.Scaffold: [languageContract] :: Agg -> !EffectiveLanguageContract

+ Keiro.Dsl.Scaffold: [loc] :: ResolvedRegister -> !Loc

+ Keiro.Dsl.Scaffold: [moduleName] :: NominalGenerationOwner -> !Text

+ Keiro.Dsl.Scaffold: [name] :: ResolvedCtor -> !Text

+ Keiro.Dsl.Scaffold: [noOpType] :: ResolvedDomainOutcomeTypes -> !ResolvedAggregateType

+ Keiro.Dsl.Scaffold: [outputMappings] :: Agg -> !Map (Int, Int) EventOutputMapping

+ Keiro.Dsl.Scaffold: [ownerKind] :: ModuleRole -> !Text

+ Keiro.Dsl.Scaffold: [ownerName] :: ModuleRole -> !Text

+ Keiro.Dsl.Scaffold: [owner] :: StructuralProjection -> !HaskellSource

+ Keiro.Dsl.Scaffold: [path] :: ScaffoldModule -> !FilePath

+ Keiro.Dsl.Scaffold: [pointer] :: StructuralProjection -> !Text

+ Keiro.Dsl.Scaffold: [projection] :: Agg -> !Maybe ProjectionSpec

+ Keiro.Dsl.Scaffold: [readModels] :: Agg -> ![ReadModelNode]

+ Keiro.Dsl.Scaffold: [regs] :: Agg -> ![ResolvedRegister]

+ Keiro.Dsl.Scaffold: [rejectionType] :: ResolvedDomainOutcomeTypes -> !ResolvedAggregateType

+ Keiro.Dsl.Scaffold: [result] :: StructuralProjection -> !Text

+ Keiro.Dsl.Scaffold: [selectors] :: StructuralProjection -> ![(Text, Text)]

+ Keiro.Dsl.Scaffold: [snapshot] :: Agg -> !Maybe SnapshotSpec

+ Keiro.Dsl.Scaffold: [spec] :: Agg -> !Spec

+ Keiro.Dsl.Scaffold: [states] :: Agg -> ![StateDecl]

+ Keiro.Dsl.Scaffold: [symbols] :: Agg -> !AggregateSymbols

+ Keiro.Dsl.Scaffold: [tag] :: StructuralProjection -> !Text

+ Keiro.Dsl.Scaffold: [text] :: ScaffoldModule -> !Text

+ Keiro.Dsl.Scaffold: [transitions] :: Agg -> ![Transition]

+ Keiro.Dsl.Scaffold: [typeGraph] :: Agg -> !Maybe TypeGraph

+ Keiro.Dsl.Scaffold: [upcastFrom] :: ResolvedCtor -> !Maybe Int

+ Keiro.Dsl.Scaffold: [useSites] :: NominalGenerationOwner -> !Set NominalUseSite

+ Keiro.Dsl.Scaffold: [valueType] :: ResolvedRegister -> !ResolvedAggregateType

+ Keiro.Dsl.Scaffold: [version] :: ResolvedCtor -> !Int

+ Keiro.Dsl.Scaffold: [vertexType] :: Agg -> !Text

+ Keiro.Dsl.Scaffold: [wire] :: Agg -> !WireSpec

+ Keiro.Dsl.Scaffold: [witness] :: StructuralProjection -> !Text

+ Keiro.Dsl.Scaffold: modernizeScaffoldModule :: ScaffoldModule -> ScaffoldModule

+ Keiro.Dsl.ScaffoldRecord: IdiomaticNamingV2 :: GeneratedHaskellNamingEdition

+ Keiro.Dsl.ScaffoldRecord: [behaviorRequirements] :: ScaffoldRecord -> ![BehaviorRecordRow]

+ Keiro.Dsl.ScaffoldRecord: [bindingObligations] :: ScaffoldRecord -> ![BindingHole]

+ Keiro.Dsl.ScaffoldRecord: [files] :: ScaffoldRecord -> ![(ModuleKind, FilePath)]

+ Keiro.Dsl.ScaffoldRecord: [idDomains] :: ScaffoldRecord -> ![Text]

+ Keiro.Dsl.ScaffoldRecord: [kind] :: ScaffoldModuleRoleRow -> !ModuleKind

+ Keiro.Dsl.ScaffoldRecord: [languageContract] :: ScaffoldRecord -> !EffectiveLanguageContract

+ Keiro.Dsl.ScaffoldRecord: [layout] :: ScaffoldRecord -> !Text

+ Keiro.Dsl.ScaffoldRecord: [mappings] :: ScaffoldRecord -> ![MappingIdentity]

+ Keiro.Dsl.ScaffoldRecord: [moduleRoles] :: ScaffoldRecord -> ![ScaffoldModuleRoleRow]

+ Keiro.Dsl.ScaffoldRecord: [moduleRoot] :: ScaffoldRecord -> !Text

+ Keiro.Dsl.ScaffoldRecord: [namingEdition] :: ScaffoldRecord -> !GeneratedHaskellNamingEdition

+ Keiro.Dsl.ScaffoldRecord: [nominalEqualities] :: ScaffoldRecord -> ![Text]

+ Keiro.Dsl.ScaffoldRecord: [path] :: ScaffoldModuleRoleRow -> !FilePath

+ Keiro.Dsl.ScaffoldRecord: [projectionCatalogFacts] :: ScaffoldRecord -> ![Text]

+ Keiro.Dsl.ScaffoldRecord: [queryContractBaseline] :: ScaffoldRecord -> !Bool

+ Keiro.Dsl.ScaffoldRecord: [queryContracts] :: ScaffoldRecord -> ![QueryContractIdentity]

+ Keiro.Dsl.ScaffoldRecord: [role] :: ScaffoldModuleRoleRow -> !ModuleRole

+ Keiro.Dsl.ScaffoldRecord: [routerSelections] :: ScaffoldRecord -> ![RouterSelectionSnapshot]

+ Keiro.Dsl.ScaffoldRecord: [semanticImpact] :: ScaffoldRecord -> !Maybe SemanticImpactSnapshot

+ Keiro.Dsl.ScaffoldRecord: [sourceLanguage] :: ScaffoldRecord -> !SourceLanguage

+ Keiro.Dsl.ScaffoldRecord: [specPath] :: ScaffoldRecord -> !Text

+ Keiro.Dsl.ScaffoldRun: GeneratedHaskellEditionImpact :: !GeneratedHaskellNamingEdition -> ![FilePath] -> ![FilePath] -> ![GeneratedHaskellEditionUse] -> GeneratedHaskellEditionImpact

+ Keiro.Dsl.ScaffoldRun: GeneratedHaskellEditionRefusal :: ![Text] -> Refusal

+ Keiro.Dsl.ScaffoldRun: GeneratedHaskellEditionRequired :: !GeneratedHaskellEditionImpact -> Refusal

+ Keiro.Dsl.ScaffoldRun: GeneratedHaskellEditionUse :: !FilePath -> !Int -> !Text -> !Text -> !HoleUseForm -> GeneratedHaskellEditionUse

+ Keiro.Dsl.ScaffoldRun: LedgerAbsent :: LedgerRead a

+ Keiro.Dsl.ScaffoldRun: LedgerParsed :: !a -> LedgerRead a

+ Keiro.Dsl.ScaffoldRun: LedgerReadUnreadable :: !FilePath -> LedgerRead a

+ Keiro.Dsl.ScaffoldRun: LedgerUnreadable :: !FilePath -> Refusal

+ Keiro.Dsl.ScaffoldRun: OperatorOperand :: HoleUseForm

+ Keiro.Dsl.ScaffoldRun: PrefixApplication :: HoleUseForm

+ Keiro.Dsl.ScaffoldRun: QualifiedApplication :: HoleUseForm

+ Keiro.Dsl.ScaffoldRun: RecordDotRenamed :: HoleUseForm

+ Keiro.Dsl.ScaffoldRun: RecordFieldBinding :: HoleUseForm

+ Keiro.Dsl.ScaffoldRun: [addedBehavior] :: ScaffoldReport -> ![BehaviorRecordRow]

+ Keiro.Dsl.ScaffoldRun: [category] :: GeneratedArtifactImpact -> !GeneratedArtifactCategory

+ Keiro.Dsl.ScaffoldRun: [conformancePackage] :: ScaffoldReport -> !Maybe ConformancePackageReport

+ Keiro.Dsl.ScaffoldRun: [constraintPlan] :: ScaffoldReport -> ![Text]

+ Keiro.Dsl.ScaffoldRun: [consumerPlan] :: ScaffoldReport -> !ConsumerPlan

+ Keiro.Dsl.ScaffoldRun: [context] :: ScaffoldReport -> !Context

+ Keiro.Dsl.ScaffoldRun: [current] :: SourceLanguageDrift -> !SourceLanguage

+ Keiro.Dsl.ScaffoldRun: [disposition] :: GeneratedArtifactImpact -> !WriteDisposition

+ Keiro.Dsl.ScaffoldRun: [dispositions] :: ScaffoldReport -> ![(ScaffoldModule, WriteDisposition)]

+ Keiro.Dsl.ScaffoldRun: [form] :: GeneratedHaskellEditionUse -> !HoleUseForm

+ Keiro.Dsl.ScaffoldRun: [fromEdition] :: GeneratedHaskellEditionImpact -> !GeneratedHaskellNamingEdition

+ Keiro.Dsl.ScaffoldRun: [generatedArtifactImpact] :: ScaffoldReport -> ![GeneratedArtifactImpact]

+ Keiro.Dsl.ScaffoldRun: [generatedEvidence] :: StaleModule -> !Maybe StaleGeneratedEvidence

+ Keiro.Dsl.ScaffoldRun: [generatedPaths] :: GeneratedHaskellEditionImpact -> ![FilePath]

+ Keiro.Dsl.ScaffoldRun: [handOwnedUses] :: GeneratedHaskellEditionImpact -> ![GeneratedHaskellEditionUse]

+ Keiro.Dsl.ScaffoldRun: [inertNodes] :: ScaffoldReport -> ![(Text, Text)]

+ Keiro.Dsl.ScaffoldRun: [kind] :: StaleModule -> !ModuleKind

+ Keiro.Dsl.ScaffoldRun: [line] :: GeneratedHaskellEditionUse -> !Int

+ Keiro.Dsl.ScaffoldRun: [manifestPath] :: ScaffoldReport -> !FilePath

+ Keiro.Dsl.ScaffoldRun: [mappingDrift] :: ScaffoldReport -> ![MappingDrift]

+ Keiro.Dsl.ScaffoldRun: [nameMoves] :: ScaffoldReport -> ![SourceMove]

+ Keiro.Dsl.ScaffoldRun: [newHoles] :: ScaffoldReport -> ![BindingHole]

+ Keiro.Dsl.ScaffoldRun: [obsoleteOutputHooks] :: ScaffoldReport -> ![(Text, Text)]

+ Keiro.Dsl.ScaffoldRun: [outDir] :: ScaffoldReport -> !FilePath

+ Keiro.Dsl.ScaffoldRun: [owner] :: QueryContractMigration -> !Text

+ Keiro.Dsl.ScaffoldRun: [path] :: QueryContractMigration -> !FilePath

+ Keiro.Dsl.ScaffoldRun: [previousSpecPath] :: ScaffoldReport -> !Maybe Text

+ Keiro.Dsl.ScaffoldRun: [previous] :: SourceLanguageDrift -> !SourceLanguage

+ Keiro.Dsl.ScaffoldRun: [projectionMappedImpact] :: ScaffoldReport -> !Maybe ProjectionMappedImpact

+ Keiro.Dsl.ScaffoldRun: [queryContractBaselineUnavailable] :: ScaffoldReport -> !Bool

+ Keiro.Dsl.ScaffoldRun: [queryContractDrift] :: ScaffoldReport -> ![QueryContractDrift]

+ Keiro.Dsl.ScaffoldRun: [queryContractMigrations] :: ScaffoldReport -> ![QueryContractMigration]

+ Keiro.Dsl.ScaffoldRun: [recordPath] :: ScaffoldReport -> !FilePath

+ Keiro.Dsl.ScaffoldRun: [removedBehavior] :: ScaffoldReport -> ![BehaviorRecordRow]

+ Keiro.Dsl.ScaffoldRun: [replacement] :: GeneratedHaskellEditionUse -> !Text

+ Keiro.Dsl.ScaffoldRun: [requiredImport] :: QueryContractMigration -> !Text

+ Keiro.Dsl.ScaffoldRun: [role] :: GeneratedArtifactImpact -> !ModuleRole

+ Keiro.Dsl.ScaffoldRun: [routerSelectionDrift] :: ScaffoldReport -> ![RouterSelectionDrift]

+ Keiro.Dsl.ScaffoldRun: [semanticImpact] :: ScaffoldReport -> !SemanticImpactReport

+ Keiro.Dsl.ScaffoldRun: [sidecarMoves] :: ScaffoldReport -> ![SidecarMove]

+ Keiro.Dsl.ScaffoldRun: [sidecarPaths] :: GeneratedHaskellEditionImpact -> ![FilePath]

+ Keiro.Dsl.ScaffoldRun: [sourceLanguageDrift] :: ScaffoldReport -> !Maybe SourceLanguageDrift

+ Keiro.Dsl.ScaffoldRun: [specName] :: MappingDrift -> !Text

+ Keiro.Dsl.ScaffoldRun: [specPath] :: ScaffoldReport -> !FilePath

+ Keiro.Dsl.ScaffoldRun: [stale] :: ScaffoldReport -> ![StaleModule]

+ Keiro.Dsl.ScaffoldRun: applyPreparedGeneratedHaskellEditionMigration :: FilePath -> Maybe PreparedGeneratedHaskellEditionMigration -> IO ()

+ Keiro.Dsl.ScaffoldRun: data GeneratedHaskellEditionImpact

+ Keiro.Dsl.ScaffoldRun: data GeneratedHaskellEditionUse

+ Keiro.Dsl.ScaffoldRun: data HoleUseForm

+ Keiro.Dsl.ScaffoldRun: data LedgerRead a

+ Keiro.Dsl.ScaffoldRun: data PreparedGeneratedHaskellEditionMigration

+ Keiro.Dsl.ScaffoldRun: executeServiceScaffoldWithRuntimePackageAndMigrations :: Maybe RuntimePackageName -> Bool -> Bool -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)

+ Keiro.Dsl.ScaffoldRun: generatedHaskellEditionBackupRoot :: GeneratedHaskellNamingEdition -> FilePath

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Eq Keiro.Dsl.ScaffoldRun.GeneratedHaskellEditionImpact

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Eq Keiro.Dsl.ScaffoldRun.GeneratedHaskellEditionUse

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Eq Keiro.Dsl.ScaffoldRun.HoleUseForm

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Eq Keiro.Dsl.ScaffoldRun.PreparedGeneratedHaskellEditionMigration

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Eq a => GHC.Classes.Eq (Keiro.Dsl.ScaffoldRun.LedgerRead a)

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Ord Keiro.Dsl.ScaffoldRun.GeneratedHaskellEditionUse

+ Keiro.Dsl.ScaffoldRun: instance GHC.Classes.Ord Keiro.Dsl.ScaffoldRun.HoleUseForm

+ Keiro.Dsl.ScaffoldRun: instance GHC.Internal.Show.Show Keiro.Dsl.ScaffoldRun.GeneratedHaskellEditionImpact

+ Keiro.Dsl.ScaffoldRun: instance GHC.Internal.Show.Show Keiro.Dsl.ScaffoldRun.GeneratedHaskellEditionUse

+ Keiro.Dsl.ScaffoldRun: instance GHC.Internal.Show.Show Keiro.Dsl.ScaffoldRun.HoleUseForm

+ Keiro.Dsl.ScaffoldRun: instance GHC.Internal.Show.Show Keiro.Dsl.ScaffoldRun.PreparedGeneratedHaskellEditionMigration

+ Keiro.Dsl.ScaffoldRun: instance GHC.Internal.Show.Show a => GHC.Internal.Show.Show (Keiro.Dsl.ScaffoldRun.LedgerRead a)

+ Keiro.Dsl.ScaffoldRun: ledgerToMaybe :: LedgerRead a -> Maybe a

+ Keiro.Dsl.ScaffoldRun: preflightGeneratedHaskellEditionMigration :: FilePath -> Maybe GeneratedHaskellNamingEdition -> [(ModuleKind, FilePath)] -> [FilePath] -> IO (Either [Text] (Maybe PreparedGeneratedHaskellEditionMigration))

+ Keiro.Dsl.ScaffoldRun: preparedGeneratedHaskellEditionImpact :: PreparedGeneratedHaskellEditionMigration -> GeneratedHaskellEditionImpact

+ Keiro.Dsl.ScaffoldRun: readRecord :: FilePath -> IO (LedgerRead ScaffoldRecord)

+ Keiro.Dsl.ScaffoldRun: withGeneratedHaskellEditionSourceMoves :: [SourceMove] -> Maybe PreparedGeneratedHaskellEditionMigration -> Maybe PreparedGeneratedHaskellEditionMigration

+ Keiro.Dsl.SemanticContract: EffectiveLanguageContract :: !LanguageVersion -> !RuntimeSemanticsProfile -> EffectiveLanguageContract

+ Keiro.Dsl.SemanticContract: [contractLanguageVersion] :: EffectiveLanguageContract -> !LanguageVersion

+ Keiro.Dsl.SemanticContract: [runtimeProfile] :: EffectiveLanguageContract -> !RuntimeSemanticsProfile

+ Keiro.Dsl.SemanticImpact: [aggregateDeclarations] :: SemanticImpact -> !Map MappedConsumer (Set MappedKey)

+ Keiro.Dsl.SemanticImpact: [consumer] :: MappedRootEvidence -> !MappedConsumer

+ Keiro.Dsl.SemanticImpact: [currentConsequences] :: MappedImpactDelta -> !Maybe (Set MappedConsequence)

+ Keiro.Dsl.SemanticImpact: [currentConsumers] :: MappedImpactDelta -> !Set MappedConsumer

+ Keiro.Dsl.SemanticImpact: [currentEvidence] :: MappedImpactDelta -> !Maybe (Set MappedRootEvidence)

+ Keiro.Dsl.SemanticImpact: [current] :: SemanticImpactReport -> !SemanticImpactSnapshot

+ Keiro.Dsl.SemanticImpact: [declarationConsequences] :: SemanticImpact -> !Map MappedKey (Set MappedConsequence)

+ Keiro.Dsl.SemanticImpact: [declarationConsumers] :: SemanticImpact -> !Map MappedKey (Set MappedConsumer)

+ Keiro.Dsl.SemanticImpact: [declarationEvidence] :: SemanticImpact -> !Map MappedKey (Set MappedRootEvidence)

+ Keiro.Dsl.SemanticImpact: [declarationIdentities] :: SemanticImpactSnapshot -> !Map MappedKey Text

+ Keiro.Dsl.SemanticImpact: [declaration] :: MappedImpactDelta -> !MappedKey

+ Keiro.Dsl.SemanticImpact: [declarations] :: SemanticImpactReport -> ![MappedKey]

+ Keiro.Dsl.SemanticImpact: [deltas] :: SemanticImpactReport -> ![MappedImpactDelta]

+ Keiro.Dsl.SemanticImpact: [kind] :: MappedRoot -> !MappedRootKind

+ Keiro.Dsl.SemanticImpact: [mappedConsequences] :: SemanticImpactSnapshot -> !Maybe (Map MappedKey (Set MappedConsequence))

+ Keiro.Dsl.SemanticImpact: [mappedConsumers] :: SemanticImpactSnapshot -> !Map MappedKey (Set MappedConsumer)

+ Keiro.Dsl.SemanticImpact: [mappedEvidence] :: SemanticImpactSnapshot -> !Maybe (Map MappedKey (Set MappedRootEvidence))

+ Keiro.Dsl.SemanticImpact: [operation] :: MappedRootEvidence -> !Maybe Text

+ Keiro.Dsl.SemanticImpact: [path] :: MappedRootEvidence -> !Text

+ Keiro.Dsl.SemanticImpact: [previousConsequences] :: MappedImpactDelta -> !Maybe (Set MappedConsequence)

+ Keiro.Dsl.SemanticImpact: [previousConsumers] :: MappedImpactDelta -> !Set MappedConsumer

+ Keiro.Dsl.SemanticImpact: [previousEvidence] :: MappedImpactDelta -> !Maybe (Set MappedRootEvidence)

+ Keiro.Dsl.SemanticImpact: [previous] :: SemanticImpactReport -> !Maybe SemanticImpactSnapshot

+ Keiro.Dsl.SemanticImpact: [rootKind] :: MappedRootEvidence -> !MappedRootKind

+ Keiro.Dsl.SemanticImpact: [roots] :: SemanticImpact -> ![MappedRoot]

+ Keiro.Dsl.SemanticImpact: [serviceConformance] :: MappedImpactDelta -> !Bool

+ Keiro.Dsl.SemanticImpact: [serviceDeclarations] :: SemanticImpact -> !Set MappedKey

+ Keiro.Dsl.SemanticImpact: [serviceInventory] :: SemanticImpactSnapshot -> !Set MappedKey

+ Keiro.Dsl.SemanticImpact: [unsupportedProjectionSources] :: SemanticImpact -> ![UnsupportedProjectionSource]

+ Keiro.Dsl.SemanticImpact: [usePaths] :: SemanticImpact -> !Map MappedKey [UsePath]

+ Keiro.Dsl.SemanticImpact: [useSite] :: MappedRoot -> !UseSite

+ Keiro.Dsl.SidecarMigration: [backupPath] :: SidecarMove -> !Maybe FilePath

+ Keiro.Dsl.SidecarMigration: [moveDisposition] :: SidecarMove -> !SidecarMoveDisposition

+ Keiro.Dsl.SidecarMigration: [newPath] :: SidecarMove -> !FilePath

+ Keiro.Dsl.SidecarMigration: [oldPath] :: SidecarMove -> !FilePath

+ Keiro.Dsl.SourceIndex: [code] :: SourceIndexFailure -> !SourceIndexFailureCode

+ Keiro.Dsl.SourceIndex: [message] :: SourceIndexFailure -> !Text

+ Keiro.Dsl.SourceIndex: [parsedSource] :: ParsedSourceDocument -> !ParsedSource

+ Keiro.Dsl.SourceIndex: [sourceIndex] :: ParsedSourceDocument -> !SemanticSourceIndex

+ Keiro.Dsl.SourceIndex: [span] :: SourceIndexFailure -> !Maybe SourceSpan

+ Keiro.Dsl.SourceIndex: [subject] :: SourceIndexFailure -> !Maybe SourceSubject

+ Keiro.Dsl.TypeGraph: [bindingVersion] :: StructuralDecl -> !BindingVersion

+ Keiro.Dsl.TypeGraph: [binding] :: StructuralDecl -> !QualifiedValueName

+ Keiro.Dsl.TypeGraph: [canonical] :: StructuralDecl -> !CanonicalTypeId

+ Keiro.Dsl.TypeGraph: [codecIdentity] :: OpaqueDecl -> !CodecIdentity

+ Keiro.Dsl.TypeGraph: [codecVersion] :: OpaqueDecl -> !CodecVersion

+ Keiro.Dsl.TypeGraph: [ctor] :: ResolvedWireArm -> !Name

+ Keiro.Dsl.TypeGraph: [declarations] :: TypeGraph -> !Map MappedKey ResolvedMappedDecl

+ Keiro.Dsl.TypeGraph: [derivedMappedConsumers] :: TypeGraph -> ![DerivedMappedConsumer]

+ Keiro.Dsl.TypeGraph: [fixtures] :: OpaqueDecl -> !QualifiedValueName

+ Keiro.Dsl.TypeGraph: [haskell] :: ResolvedWireField -> !Name

+ Keiro.Dsl.TypeGraph: [initial] :: OpaqueDecl -> !Maybe QualifiedValueName

+ Keiro.Dsl.TypeGraph: [key] :: ResolvedWireField -> !Text

+ Keiro.Dsl.TypeGraph: [loc] :: ResolvedWireArm -> !Loc

+ Keiro.Dsl.TypeGraph: [name] :: OpaqueDecl -> !Name

+ Keiro.Dsl.TypeGraph: [onMissing] :: ResolvedWireField -> !Maybe OnMissing

+ Keiro.Dsl.TypeGraph: [payload] :: ResolvedWireArm -> !Maybe ResolvedTypeExpr

+ Keiro.Dsl.TypeGraph: [presence] :: ResolvedWireField -> !Presence

+ Keiro.Dsl.TypeGraph: [projectionOperationalIdentities] :: TypeGraph -> !Map DerivedMappedConsumer Text

+ Keiro.Dsl.TypeGraph: [reachability] :: TypeGraph -> !Map MappedKey (Set MappedKey)

+ Keiro.Dsl.TypeGraph: [replayableProjectionGroups] :: TypeGraph -> !Map DerivedMappedConsumer Name

+ Keiro.Dsl.TypeGraph: [rootSegments] :: TypeGraph -> !Map UseSite [PathSeg]

+ Keiro.Dsl.TypeGraph: [root] :: UsePath -> !UseSite

+ Keiro.Dsl.TypeGraph: [segments] :: UsePath -> ![PathSeg]

+ Keiro.Dsl.TypeGraph: [tag] :: ResolvedWireArm -> !Text

+ Keiro.Dsl.TypeGraph: [unsupportedProjectionSources] :: TypeGraph -> ![UnsupportedProjectionSource]

+ Keiro.Dsl.TypeGraph: [useSites] :: TypeGraph -> ![UseSite]

+ Keiro.Dsl.TypeGraph: [valueType] :: ResolvedWireField -> !ResolvedTypeExpr

+ Keiro.Dsl.TypeGraph: unBindingVersion :: BindingVersion -> Text

+ Keiro.Dsl.TypeGraph: unCanonicalTypeId :: CanonicalTypeId -> Text

+ Keiro.Dsl.TypeGraph: unCodecIdentity :: CodecIdentity -> Text

+ Keiro.Dsl.TypeGraph: unCodecVersion :: CodecVersion -> Text

+ Keiro.Dsl.TypeGraph: unMappedKey :: MappedKey -> Name

+ Keiro.Dsl.TypeGraph: unQualifiedValueName :: QualifiedValueName -> Text

+ Keiro.Dsl.Workspace: [code] :: WorkspaceDiagnostic -> !DiagnosticCode

+ Keiro.Dsl.Workspace: [context] :: WorkspaceSpec -> !Name

+ Keiro.Dsl.Workspace: [declarations] :: OwnershipIndex -> !Map (Text, Name) (FilePath, Loc)

+ Keiro.Dsl.Workspace: [file] :: WorkspaceLocation -> !WorkspaceFile

+ Keiro.Dsl.Workspace: [languageContract] :: WorkspaceSpec -> !EffectiveLanguageContract

+ Keiro.Dsl.Workspace: [layoutLoc] :: WorkspaceManifest -> !Loc

+ Keiro.Dsl.Workspace: [layout] :: WorkspaceSpec -> !Maybe Placement

+ Keiro.Dsl.Workspace: [lineBase] :: WorkspaceMember -> !Int

+ Keiro.Dsl.Workspace: [lineCount] :: WorkspaceMember -> !Int

+ Keiro.Dsl.Workspace: [lineMap] :: WorkspaceSpec -> !LineMap

+ Keiro.Dsl.Workspace: [line] :: WorkspaceLocation -> !Int

+ Keiro.Dsl.Workspace: [loc] :: WorkspaceMemberRef -> !Loc

+ Keiro.Dsl.Workspace: [locations] :: WorkspaceDiagnostic -> !NonEmpty WorkspaceLocation

+ Keiro.Dsl.Workspace: [manifestPath] :: WorkspaceSpec -> !FilePath

+ Keiro.Dsl.Workspace: [members] :: WorkspaceSpec -> ![WorkspaceMember]

+ Keiro.Dsl.Workspace: [mergedSpec] :: WorkspaceSpec -> !Spec

+ Keiro.Dsl.Workspace: [message] :: WorkspaceDiagnostic -> !Text

+ Keiro.Dsl.Workspace: [moduleRootLoc] :: WorkspaceManifest -> !Loc

+ Keiro.Dsl.Workspace: [moduleRoot] :: WorkspaceSpec -> !Maybe Text

+ Keiro.Dsl.Workspace: [nodes] :: OwnershipIndex -> !Map (Text, Name) (FilePath, Loc)

+ Keiro.Dsl.Workspace: [ownership] :: WorkspaceSpec -> !OwnershipIndex

+ Keiro.Dsl.Workspace: [path] :: WorkspaceMember -> !FilePath

+ Keiro.Dsl.Workspace: [role] :: WorkspaceLocation -> !Text

+ Keiro.Dsl.Workspace: [runtimePackageLoc] :: WorkspaceManifest -> !Loc

+ Keiro.Dsl.Workspace: [runtimePackage] :: WorkspaceSpec -> !Maybe RuntimePackageName

+ Keiro.Dsl.Workspace: [serviceLoc] :: WorkspaceManifest -> !Loc

+ Keiro.Dsl.Workspace: [service] :: WorkspaceSpec -> !Text

+ Keiro.Dsl.Workspace: [severity] :: WorkspaceDiagnostic -> !Severity

+ Keiro.Dsl.Workspace: [sourceIndex] :: WorkspaceMember -> !SemanticSourceIndex

+ Keiro.Dsl.Workspace: [sourceLanguageCause] :: WorkspaceDiagnostic -> !Maybe SourceLanguageDiagnostic

+ Keiro.Dsl.Workspace: [sourceLanguage] :: WorkspaceMember -> !SourceLanguage

+ Keiro.Dsl.Workspace: [spec] :: WorkspaceMember -> !Spec

+ Keiro.Dsl.WorkspaceAdoption: [claimed] :: MigrationReport -> ![ClaimedFile]

+ Keiro.Dsl.WorkspaceAdoption: [evidence] :: ClaimedFile -> !ClaimEvidence

+ Keiro.Dsl.WorkspaceAdoption: [legacyRecord] :: MigrationReport -> !Maybe (FilePath, Text)

+ Keiro.Dsl.WorkspaceAdoption: [likelyStale] :: MigrationReport -> ![StaleModule]

+ Keiro.Dsl.WorkspaceAdoption: [path] :: ClaimedFile -> !FilePath

+ Keiro.Dsl.WorkspaceAdoption: [service] :: MigrationReport -> !Text

+ Keiro.Dsl.WorkspaceAdoption: [source] :: ClaimedFile -> !Maybe Text

+ Keiro.Dsl.WorkspaceAdoption: [spec] :: ClaimedFile -> !Maybe Text

+ Keiro.Dsl.WorkspaceAdoption: [unclaimed] :: MigrationReport -> ![FilePath]

+ Keiro.Dsl.WorkspaceDiff: [adoptionBaseline] :: WorkspaceMeta -> !Bool

+ Keiro.Dsl.WorkspaceDiff: [change] :: WorkspaceChange -> !Change

+ Keiro.Dsl.WorkspaceDiff: [declarationSite] :: WorkspaceChange -> !Maybe OwnedSite

+ Keiro.Dsl.WorkspaceDiff: [file] :: OwnedSite -> !FilePath

+ Keiro.Dsl.WorkspaceDiff: [identity] :: WorkspaceMeta -> !Text

+ Keiro.Dsl.WorkspaceDiff: [line] :: OwnedSite -> !Int

+ Keiro.Dsl.WorkspaceDiff: [manifest] :: WorkspaceMeta -> !FilePath

+ Keiro.Dsl.WorkspaceDiff: [membersNew] :: WorkspaceMeta -> ![FilePath]

+ Keiro.Dsl.WorkspaceDiff: [membersOld] :: WorkspaceMeta -> ![FilePath]

+ Keiro.Dsl.WorkspaceDiff: [since] :: WorkspaceMeta -> !Text

+ Keiro.Dsl.WorkspaceDiff: [useSites] :: WorkspaceChange -> ![(Text, Maybe OwnedSite)]

+ Keiro.Dsl.WorkspaceRecord: [adopted] :: WorkspaceRecord -> ![AdoptedRow]

+ Keiro.Dsl.WorkspaceRecord: [bindingObligations] :: WorkspaceRecord -> ![BindingHole]

+ Keiro.Dsl.WorkspaceRecord: [context] :: WorkspaceRecord -> !Text

+ Keiro.Dsl.WorkspaceRecord: [evidence] :: AdoptedRow -> !Text

+ Keiro.Dsl.WorkspaceRecord: [idDomains] :: WorkspaceRecord -> ![Text]

+ Keiro.Dsl.WorkspaceRecord: [kind] :: WorkspaceModuleRow -> !ModuleKind

+ Keiro.Dsl.WorkspaceRecord: [languageContract] :: WorkspaceRecord -> !EffectiveLanguageContract

+ Keiro.Dsl.WorkspaceRecord: [layout] :: WorkspaceRecord -> !Text

+ Keiro.Dsl.WorkspaceRecord: [manifest] :: WorkspaceRecord -> !Text

+ Keiro.Dsl.WorkspaceRecord: [mappings] :: WorkspaceRecord -> ![MappingIdentity]

+ Keiro.Dsl.WorkspaceRecord: [members] :: WorkspaceRecord -> ![FilePath]

+ Keiro.Dsl.WorkspaceRecord: [moduleRoot] :: WorkspaceRecord -> !Text

+ Keiro.Dsl.WorkspaceRecord: [modules] :: WorkspaceRecord -> ![WorkspaceModuleRow]

+ Keiro.Dsl.WorkspaceRecord: [namingEdition] :: WorkspaceRecord -> !GeneratedHaskellNamingEdition

+ Keiro.Dsl.WorkspaceRecord: [nominalEqualities] :: WorkspaceRecord -> ![Text]

+ Keiro.Dsl.WorkspaceRecord: [owner] :: WorkspaceModuleRow -> !Maybe FilePath

+ Keiro.Dsl.WorkspaceRecord: [path] :: AdoptedRow -> !FilePath

+ Keiro.Dsl.WorkspaceRecord: [projectionCatalogFacts] :: WorkspaceRecord -> ![Text]

+ Keiro.Dsl.WorkspaceRecord: [queryContractBaseline] :: WorkspaceRecord -> !Bool

+ Keiro.Dsl.WorkspaceRecord: [queryContracts] :: WorkspaceRecord -> ![QueryContractIdentity]

+ Keiro.Dsl.WorkspaceRecord: [requirements] :: WorkspaceRecord -> ![BehaviorRecordRow]

+ Keiro.Dsl.WorkspaceRecord: [role] :: WorkspaceModuleRow -> !Maybe ModuleRole

+ Keiro.Dsl.WorkspaceRecord: [routerSelections] :: WorkspaceRecord -> ![RouterSelectionSnapshot]

+ Keiro.Dsl.WorkspaceRecord: [semanticImpact] :: WorkspaceRecord -> !Maybe SemanticImpactSnapshot

+ Keiro.Dsl.WorkspaceRecord: [service] :: WorkspaceRecord -> !Text

+ Keiro.Dsl.WorkspaceRecord: [sourceLanguage] :: WorkspaceSourceLanguageRow -> !SourceLanguage

+ Keiro.Dsl.WorkspaceRecord: [sourceLanguages] :: WorkspaceRecord -> ![WorkspaceSourceLanguageRow]

+ Keiro.Dsl.WorkspaceRecord: [source] :: AdoptedRow -> !Maybe Text

+ Keiro.Dsl.WorkspaceRecord: [spec] :: AdoptedRow -> !Maybe Text

+ Keiro.Dsl.WorkspaceScaffold: [addedBehavior] :: WorkspaceScaffoldReport -> ![BehaviorRecordRow]

+ Keiro.Dsl.WorkspaceScaffold: [buildManifestPath] :: WorkspaceScaffoldReport -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [checkedService] :: WorkspacePlan -> !CheckedService

+ Keiro.Dsl.WorkspaceScaffold: [conformancePackage] :: WorkspaceScaffoldReport -> !Maybe ConformancePackageReport

+ Keiro.Dsl.WorkspaceScaffold: [constraintPlan] :: WorkspaceScaffoldReport -> ![Text]

+ Keiro.Dsl.WorkspaceScaffold: [consumerPlan] :: WorkspaceScaffoldReport -> !ConsumerPlan

+ Keiro.Dsl.WorkspaceScaffold: [context] :: WorkspaceScaffoldReport -> !Context

+ Keiro.Dsl.WorkspaceScaffold: [current] :: WorkspaceSourceLanguageDrift -> !SourceLanguage

+ Keiro.Dsl.WorkspaceScaffold: [dispositions] :: WorkspaceScaffoldReport -> ![(ScaffoldModule, ModuleProvenance, WriteDisposition)]

+ Keiro.Dsl.WorkspaceScaffold: [generatedArtifactImpact] :: WorkspaceScaffoldReport -> ![GeneratedArtifactImpact]

+ Keiro.Dsl.WorkspaceScaffold: [goldenRoot] :: WorkspacePlan -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [inertNodes] :: WorkspaceScaffoldReport -> ![(Text, Text)]

+ Keiro.Dsl.WorkspaceScaffold: [manifestPath] :: WorkspaceScaffoldReport -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [mappingDrift] :: WorkspaceScaffoldReport -> ![MappingDrift]

+ Keiro.Dsl.WorkspaceScaffold: [members] :: WorkspaceScaffoldReport -> ![FilePath]

+ Keiro.Dsl.WorkspaceScaffold: [migration] :: WorkspaceScaffoldReport -> !Maybe MigrationReport

+ Keiro.Dsl.WorkspaceScaffold: [modules] :: WorkspacePlan -> ![(ScaffoldModule, ModuleProvenance)]

+ Keiro.Dsl.WorkspaceScaffold: [nameMoves] :: WorkspaceScaffoldReport -> ![SourceMove]

+ Keiro.Dsl.WorkspaceScaffold: [newHoles] :: WorkspaceScaffoldReport -> ![BindingHole]

+ Keiro.Dsl.WorkspaceScaffold: [obsoleteOutputHooks] :: WorkspaceScaffoldReport -> ![(Text, Text)]

+ Keiro.Dsl.WorkspaceScaffold: [outDir] :: WorkspaceScaffoldReport -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [ownershipMoves] :: WorkspaceScaffoldReport -> ![OwnershipMove]

+ Keiro.Dsl.WorkspaceScaffold: [path] :: WorkspaceSourceLanguageDrift -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [previousManifest] :: WorkspaceScaffoldReport -> !Maybe Text

+ Keiro.Dsl.WorkspaceScaffold: [previous] :: WorkspaceSourceLanguageDrift -> !SourceLanguage

+ Keiro.Dsl.WorkspaceScaffold: [projectionMappedImpact] :: WorkspaceScaffoldReport -> !Maybe ProjectionMappedImpact

+ Keiro.Dsl.WorkspaceScaffold: [queryContractBaselineUnavailable] :: WorkspaceScaffoldReport -> !Bool

+ Keiro.Dsl.WorkspaceScaffold: [queryContractDrift] :: WorkspaceScaffoldReport -> ![QueryContractDrift]

+ Keiro.Dsl.WorkspaceScaffold: [queryContractMigrations] :: WorkspaceScaffoldReport -> ![QueryContractMigration]

+ Keiro.Dsl.WorkspaceScaffold: [recordPath] :: WorkspaceScaffoldReport -> !FilePath

+ Keiro.Dsl.WorkspaceScaffold: [removedBehavior] :: WorkspaceScaffoldReport -> ![BehaviorRecordRow]

+ Keiro.Dsl.WorkspaceScaffold: [routerSelectionDrift] :: WorkspaceScaffoldReport -> ![RouterSelectionDrift]

+ Keiro.Dsl.WorkspaceScaffold: [runtimePackage] :: WorkspacePlan -> !Maybe RuntimePackageName

+ Keiro.Dsl.WorkspaceScaffold: [semanticImpact] :: WorkspaceScaffoldReport -> !SemanticImpactReport

+ Keiro.Dsl.WorkspaceScaffold: [service] :: WorkspaceScaffoldReport -> !Text

+ Keiro.Dsl.WorkspaceScaffold: [sidecarMoves] :: WorkspaceScaffoldReport -> ![SidecarMove]

+ Keiro.Dsl.WorkspaceScaffold: [sourceLanguageDrift] :: WorkspaceScaffoldReport -> ![WorkspaceSourceLanguageDrift]

+ Keiro.Dsl.WorkspaceScaffold: [stale] :: WorkspaceScaffoldReport -> ![StaleModule]

+ Keiro.Dsl.WorkspaceScaffold: [workspace] :: WorkspacePlan -> !WorkspaceSpec

+ Keiro.Dsl.WorkspaceScaffold: executeWorkspaceScaffoldWithMigrations :: FilePath -> Bool -> Bool -> Bool -> WorkspacePlan -> IO (Either [Refusal] WorkspaceScaffoldReport)

+ Keiro.Dsl.WorkspaceScaffold: readWorkspaceRecord :: FilePath -> IO (LedgerRead WorkspaceRecord)

- Keiro.Dsl.Coverage: [jsonBoundaries] :: CoverageCounts -> !Int

+ Keiro.Dsl.Coverage: [jsonBoundaries] :: CoverageReport -> ![JsonBoundary]

- Keiro.Dsl.Grammar: [input] :: ReadModelQueryTypes -> !TypeExpr

+ Keiro.Dsl.Grammar: [input] :: WorkflowNode -> !Name

- Keiro.Dsl.Scaffold: [kind] :: ScaffoldModule -> !ModuleKind

+ Keiro.Dsl.Scaffold: [kind] :: NominalUseSite -> !AggregateUseSite

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

CHANGELOG.md +36/−0
app/Main.hs +160/−133
bench/structural-codec/Main.hs +0/−2
generated-haskell-edition-idiomatic-v2.md too large to diff
internal/Keiro/Dsl/GeneratedHaskellLanguage.hs +174/−0
keiro-dsl.cabal +78/−42
record-field-migration-0.15.md +1433/−0
src/Keiro/Dsl/AggregateGenerationPlan.hs +6/−6
src/Keiro/Dsl/AggregateType.hs +76/−73
src/Keiro/Dsl/BehaviorCoverage.hs +194/−171
src/Keiro/Dsl/BehaviorSourceMap.hs +89/−74
src/Keiro/Dsl/CanonicalEncoding.hs +8/−8
src/Keiro/Dsl/CheckReport.hs +110/−110
src/Keiro/Dsl/CodecCompare.hs +123/−119
src/Keiro/Dsl/ConformancePackage.hs +96/−96
src/Keiro/Dsl/ConsumerTypePlan.hs +49/−43
src/Keiro/Dsl/CoordinationImpact.hs +92/−92
src/Keiro/Dsl/Coverage.hs +294/−276
src/Keiro/Dsl/Diff.hs +3092/−3018
src/Keiro/Dsl/DiffReport.hs +105/−105
src/Keiro/Dsl/EventOutput.hs +30/−26
src/Keiro/Dsl/ExplainBindings.hs +149/−149
src/Keiro/Dsl/Expression.hs +104/−96
src/Keiro/Dsl/FieldIdentity.hs +12/−12
src/Keiro/Dsl/FoldFingerprint.hs +71/−71
src/Keiro/Dsl/Frontend/Internal.hs +75/−69
src/Keiro/Dsl/GeneratedHaskellLanguage.hs +0/−48
src/Keiro/Dsl/Goldens.hs +65/−55
src/Keiro/Dsl/Grammar.hs +382/−378
src/Keiro/Dsl/Harness.hs +301/−301
src/Keiro/Dsl/HaskellImport.hs +35/−35
src/Keiro/Dsl/HaskellName.hs +25/−22
src/Keiro/Dsl/HaskellSourceMove.hs +30/−30
src/Keiro/Dsl/IdDomain.hs +11/−11
src/Keiro/Dsl/LanguageVersion.hs +53/−53
src/Keiro/Dsl/Manifest.hs +19/−19
src/Keiro/Dsl/MappedCodecPlan.hs +7/−7
src/Keiro/Dsl/MappedConsumer.hs +102/−102
src/Keiro/Dsl/MappedDiff.hs +76/−76
src/Keiro/Dsl/NominalType.hs +100/−99
src/Keiro/Dsl/Parser.hs +1/−1
src/Keiro/Dsl/Parser/Aggregate.hs +49/−49
src/Keiro/Dsl/Parser/Coordination.hs +72/−72
src/Keiro/Dsl/Parser/Core.hs +9/−9
src/Keiro/Dsl/Parser/Declaration.hs +7/−7
src/Keiro/Dsl/Parser/Document.hs +2/−2
src/Keiro/Dsl/Parser/Integration.hs +41/−41
src/Keiro/Dsl/Parser/Mapped.hs +21/−21
src/Keiro/Dsl/Parser/Preamble.hs +20/−20
src/Keiro/Dsl/Parser/ProjectionCatalog.hs +30/−30
src/Keiro/Dsl/Parser/Queue.hs +29/−29
src/Keiro/Dsl/Parser/ReadModel.hs +12/−12
src/Keiro/Dsl/Parser/Workflow.hs +11/−11
src/Keiro/Dsl/PrettyPrint.hs +304/−304
src/Keiro/Dsl/ProjectionMappedImpact.hs +25/−25
src/Keiro/Dsl/ProjectionSupply.hs +40/−40
src/Keiro/Dsl/ReadModelQueryContract.hs +23/−23
src/Keiro/Dsl/ReadModelShape.hs +10/−10
src/Keiro/Dsl/ReplayImpact.hs +107/−74
src/Keiro/Dsl/RouterSelection.hs +174/−150
src/Keiro/Dsl/RuntimePackage.hs +4/−0
src/Keiro/Dsl/Scaffold.hs +8754/−8725
src/Keiro/Dsl/ScaffoldRecord.hs +146/−139
src/Keiro/Dsl/ScaffoldRun.hs +2047/−1713
src/Keiro/Dsl/SemanticContract.hs +25/−27
src/Keiro/Dsl/SemanticImpact.hs +230/−226
src/Keiro/Dsl/ServiceHarness.hs +13/−13
src/Keiro/Dsl/SidecarMigration.hs +58/−63
src/Keiro/Dsl/Source.hs +0/−2
src/Keiro/Dsl/SourceIndex.hs +41/−40
src/Keiro/Dsl/StructuralConformance.hs +98/−84
src/Keiro/Dsl/Syntax.hs +0/−2
src/Keiro/Dsl/TypeGraph.hs +192/−168
src/Keiro/Dsl/Validate.hs +4783/−4783
src/Keiro/Dsl/Workspace.hs +228/−228
src/Keiro/Dsl/WorkspaceAdoption.hs +42/−42
src/Keiro/Dsl/WorkspaceDiff.hs +34/−34
src/Keiro/Dsl/WorkspaceRecord.hs +133/−114
src/Keiro/Dsl/WorkspaceScaffold.hs +353/−285
test/Keiro/Dsl/ConformanceBaseline.hs +53/−52
test/Keiro/Dsl/FrontendCompatibility.hs +45/−45
test/Keiro/Dsl/FrontendProfiles.hs +13/−15
test/Keiro/Dsl/FrontendPublicApiProbe.hs +9/−9
test/Keiro/Dsl/FrontendSurface.hs +16/−18
test/Main.hs +15034/−13923
test/README.md +78/−0
test/aggregate-scalar-expression-mutation-test.sh +128/−0
test/aggregate-scalars-mutation-test.sh +51/−0
test/behavior-complete-mutation-test.sh +171/−0
test/conformance-aggregate-scalars/AggregateScalars/ScalarLedger/BehaviorHoles.hs +10/−0
test/conformance-aggregate-scalars/Generated/AggregateScalars/BehaviorSourceMap.hs +5/−5
test/conformance-aggregate-scalars/Generated/AggregateScalars/ReplayAudit.hs +1/−1
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/BehaviorContract.hs +350/−0
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Codec.hs +1/−2
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Domain.hs +1/−2
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/EventStream.hs +1/−1
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Harness.hs +1/−1
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Projection.hs +1/−1
test/conformance-aggregate-scalars/Generated/AggregateScalars/ScalarLedger/Transducer.hs +1/−2
test/conformance-aggregate-scalars/keiro-dsl-cabal-fragment.context.aggregate-scalars.txt +32/−0
test/conformance-aggregate-scalars/keiro-dsl-ledger.context.aggregate-scalars.txt +32/−0
test/conformance-baseline.json +63/−0
test/conformance-behavior-complete/Generated/BehaviorComplete/BehaviorSourceMap.hs +5/−5
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/BehaviorContract.hs +263/−259
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Codec.hs +3/−4
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Domain.hs +1/−2
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/EventStream.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Harness.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Projection.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/Journey/Transducer.hs +1/−2
test/conformance-behavior-complete/Generated/BehaviorComplete/Nominals.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/Nominals/Internal.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/ReplayAudit.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/Structural/Shape/StartPayload.hs +1/−1
test/conformance-behavior-complete/Generated/BehaviorComplete/StructuralConformance.hs +4/−4
test/conformance-behavior-complete/Generated/BehaviorComplete/StructuralProjections.hs +3/−3
test/conformance-behavior-complete/behavior-complete-report.cabal +42/−0
test/conformance-behavior-complete/keiro-dsl-cabal-fragment.context.behavior-complete.txt +45/−0
test/conformance-behavior-complete/keiro-dsl-ledger.context.behavior-complete.txt +65/−0
test/conformance-codec-compare/Conformance/CodecCompare/Historical.hs +8/−8
test/conformance-codec-compare/Main.hs +6/−6
test/conformance-codec-compare/RunnerMain.hs +25/−0
test/conformance-codec-compare/fixtures/artifact-info/canonical.json +10/−0
test/conformance-codec-compare/fixtures/artifact-info/local-dir-null.json +10/−0
test/conformance-codec-compare/fixtures/artifact-info/local-file-missing.json +6/−0
test/conformance-codec-compare/fixtures/artifact-info/repo-path.json +10/−0
test/conformance-codec-compare/fixtures/artifact-info/url.json +10/−0
test/conformance-codec-compare/fixtures/generated-parity/canonical.json +10/−0
test/conformance-codec-compare/fixtures/generated-parity/local-dir-null.json +10/−0
test/conformance-codec-compare/fixtures/generated-parity/local-file-missing.json +6/−0
test/conformance-codec-compare/fixtures/generated-parity/repo-path.json +10/−0
test/conformance-codec-compare/fixtures/generated-parity/url.json +10/−0
test/conformance-codec-compare/fixtures/missing-arm/local-file.json +6/−0
test/conformance-coldstart/Billing/Subscription/BehaviorHoles.hs +14/−0
test/conformance-coldstart/Generated/Billing/BehaviorSourceMap.hs +5/−5
test/conformance-coldstart/Generated/Billing/Nominals.hs +1/−1
test/conformance-coldstart/Generated/Billing/Nominals/Internal.hs +1/−1
test/conformance-coldstart/Generated/Billing/ReplayAudit.hs +1/−1
test/conformance-coldstart/Generated/Billing/Subscription/BehaviorContract.hs +399/−0
test/conformance-coldstart/Generated/Billing/Subscription/Codec.hs +1/−2
test/conformance-coldstart/Generated/Billing/Subscription/Domain.hs +1/−2
test/conformance-coldstart/Generated/Billing/Subscription/EventStream.hs +1/−1
test/conformance-coldstart/Generated/Billing/Subscription/Harness.hs +1/−1
test/conformance-coldstart/Generated/Billing/Subscription/Projection.hs +1/−1
test/conformance-coldstart/Generated/Billing/Subscription/Transducer.hs +1/−2
test/conformance-coldstart/keiro-dsl-cabal-fragment.context.billing.txt +33/−0
test/conformance-coldstart/keiro-dsl-ledger.context.billing.txt +45/−0
test/conformance-contract-v1-compat/Generated/HospitalCapacity/Emergency/Contract.hs +1/−3
test/conformance-contract-v1-compat/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +19/−0
test/conformance-contract-v1-compat/keiro-dsl-ledger.context.hospital-capacity.txt +10/−0
test/conformance-contract/Generated/HospitalCapacity/Emergency/Contract.hs +1/−3
test/conformance-contract/Main.hs +3/−3
test/conformance-contract/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +21/−0
test/conformance-contract/keiro-dsl-ledger.context.hospital-capacity.txt +14/−0
test/conformance-corpus-manifest.txt +127/−0
test/conformance-declarative-router/Generated/TransferRouting/BehaviorSourceMap.hs +5/−5
test/conformance-declarative-router/Generated/TransferRouting/Hospital/BehaviorContract.hs +110/−106
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Codec.hs +1/−2
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Domain.hs +1/−2
test/conformance-declarative-router/Generated/TransferRouting/Hospital/EventStream.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Harness.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Projection.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/Hospital/Transducer.hs +1/−2
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/QueryContract.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModel.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModelHarness.hs +1/−2
test/conformance-declarative-router/Generated/TransferRouting/HospitalLoad/ReadModelTable.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/HospitalTransferRouter/Router.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/HospitalTransferRouter/RouterHarness.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/ProjectionCatalog.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/ReplayAudit.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/Structural/Shape/HospitalLoadRow.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/Structural/Shape/TransferRouteInput.hs +1/−1
test/conformance-declarative-router/Generated/TransferRouting/StructuralConformance.hs +8/−8
test/conformance-declarative-router/Generated/TransferRouting/StructuralProjections.hs +8/−8
test/conformance-declarative-router/README.md +23/−0
test/conformance-declarative-router/keiro-dsl-cabal-fragment.context.transfer-routing.txt +56/−0
test/conformance-declarative-router/keiro-dsl-ledger.context.transfer-routing.txt +79/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs +60/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs +32/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs +9/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/Queue.hs +1/−2
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs +1/−1
test/conformance-dispatch-full/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs +1/−1
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs +60/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs +32/−0
test/conformance-dispatch-full/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs +9/−0
test/conformance-dispatch-full/HospitalCapacity/AcceptedTransferNeeds/ReadModelHoles.hs +26/−0
test/conformance-dispatch-full/HospitalCapacity/TransferDecisions/ReadModelHoles.hs +25/−0
test/conformance-dispatch-full/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +35/−0
test/conformance-dispatch-full/keiro-dsl-ledger.context.hospital-capacity.txt +30/−0
test/conformance-domain-outcomes/Generated/DomainOutcomes/BehaviorSourceMap.hs +5/−5
test/conformance-domain-outcomes/Generated/DomainOutcomes/Nominals.hs +1/−1
test/conformance-domain-outcomes/Generated/DomainOutcomes/ReplayAudit.hs +1/−1
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/BehaviorContract.hs +119/−115
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Codec.hs +1/−2
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Domain.hs +1/−2
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/EventStream.hs +1/−1
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Harness.hs +1/−1
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Projection.hs +1/−1
test/conformance-domain-outcomes/Generated/DomainOutcomes/Reservation/Transducer.hs +1/−2
test/conformance-domain-outcomes/keiro-dsl-cabal-fragment.context.domain-outcomes.txt +31/−0
test/conformance-domain-outcomes/keiro-dsl-ledger.context.domain-outcomes.txt +35/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/BehaviorSourceMap.hs +5/−5
test/conformance-id-domain-migration/Generated/IdDomainMigration/Nominals.hs +1/−1
test/conformance-id-domain-migration/Generated/IdDomainMigration/Nominals/Internal.hs +1/−1
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/BehaviorContract.hs +350/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Codec.hs +1/−2
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Domain.hs +1/−2
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/EventStream.hs +63/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Harness.hs +59/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Projection.hs +4/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/OrderBook/Transducer.hs +57/−0
test/conformance-id-domain-migration/Generated/IdDomainMigration/ReplayAudit.hs +23/−0
test/conformance-id-domain-migration/IdDomainMigration/OrderBook/BehaviorHoles.hs +10/−0
test/conformance-id-domain-migration/Main.hs +1/−1
test/conformance-id-domain-migration/keiro-dsl-cabal-fragment.context.id-domain-migration.txt +32/−0
test/conformance-id-domain-migration/keiro-dsl-ledger.context.id-domain-migration.txt +36/−0
test/conformance-import-planning/Generated/ImportPlanningCollisions/BehaviorSourceMap.hs +5/−5
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/BehaviorContract.hs +110/−106
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Codec.hs +2/−3
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Domain.hs +1/−2
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/EventStream.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Harness.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Projection.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/CollisionLedger/Transducer.hs +1/−2
test/conformance-import-planning/Generated/ImportPlanningCollisions/NominalProjections.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/ReplayAudit.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/Structural/Shape/Details.hs +1/−1
test/conformance-import-planning/Generated/ImportPlanningCollisions/StructuralConformance.hs +3/−3
test/conformance-import-planning/Generated/ImportPlanningCollisions/StructuralProjections.hs +3/−3
test/conformance-import-planning/keiro-dsl-cabal-fragment.context.import-planning-collisions.txt +46/−0
test/conformance-import-planning/keiro-dsl-ledger.context.import-planning-collisions.txt +52/−0
test/conformance-intake-full/Generated/HospitalCapacity/Emergency/Contract.hs +64/−0
test/conformance-intake-full/Generated/HospitalCapacity/IncidentInbox/Inbox.hs +3/−3
test/conformance-intake-full/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +26/−0
test/conformance-intake-full/keiro-dsl-ledger.context.hospital-capacity.txt +13/−0
test/conformance-intake-runtime/Generated/HospitalCapacity/Emergency/Contract.hs +64/−0
test/conformance-intake-runtime/Generated/HospitalCapacity/IncidentInbox/Inbox.hs +3/−3
test/conformance-intake-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +26/−0
test/conformance-intake-runtime/keiro-dsl-ledger.context.hospital-capacity.txt +13/−0
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/Queue.hs +6/−7
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/QueueCodec.hs +1/−1
test/conformance-mapped-queue/Generated/MappedQueue/MappedJobs/QueuePolicy.hs +1/−1
test/conformance-mapped-queue/Generated/MappedQueue/Structural/Shape/JobMetadata.hs +1/−1
test/conformance-mapped-queue/Generated/MappedQueue/Structural/Shape/JobPayload.hs +1/−1
test/conformance-mapped-queue/Generated/MappedQueue/StructuralConformance.hs +7/−7
test/conformance-mapped-queue/Generated/MappedQueue/StructuralProjections.hs +4/−4
test/conformance-mapped-queue/Main.hs +1/−1
test/conformance-mapped-queue/keiro-dsl-cabal-fragment.context.mapped-queue.txt +36/−0
test/conformance-mapped-queue/keiro-dsl-ledger.context.mapped-queue.txt +34/−0
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/QueryContract.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModel.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModelHarness.hs +1/−2
test/conformance-mapped-readmodel/Generated/MappedReadmodel/AccountSummary/ReadModelTable.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/ProjectionCatalog.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountLookup.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountProfile.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/AccountSummary.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/TenantKey.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/Structural/Shape/UnusedFilter.hs +1/−1
test/conformance-mapped-readmodel/Generated/MappedReadmodel/StructuralConformance.hs +14/−14
test/conformance-mapped-readmodel/Generated/MappedReadmodel/StructuralProjections.hs +13/−13
test/conformance-mapped-readmodel/keiro-dsl-cabal-fragment.context.mapped-readmodel.txt +44/−0
test/conformance-mapped-readmodel/keiro-dsl-ledger.context.mapped-readmodel.txt +67/−0
test/conformance-newsurface/Generated/TransferRouting/BehaviorSourceMap.hs +5/−5
test/conformance-newsurface/Generated/TransferRouting/Hospital/BehaviorContract.hs +337/−0
test/conformance-newsurface/Generated/TransferRouting/Hospital/Codec.hs +1/−2
test/conformance-newsurface/Generated/TransferRouting/Hospital/Domain.hs +1/−2
test/conformance-newsurface/Generated/TransferRouting/Hospital/EventStream.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/Hospital/Harness.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/Hospital/Projection.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/Hospital/Transducer.hs +1/−2
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModel.hs +1/−2
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModelHarness.hs +1/−2
test/conformance-newsurface/Generated/TransferRouting/HospitalLoad/ReadModelTable.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/HospitalTransferRouter/Router.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/HospitalTransferRouter/RouterHarness.hs +1/−1
test/conformance-newsurface/Generated/TransferRouting/ReplayAudit.hs +1/−1
test/conformance-newsurface/TransferRouting/Hospital/BehaviorHoles.hs +9/−0
test/conformance-newsurface/keiro-dsl-cabal-fragment.context.transfer-routing.txt +41/−0
test/conformance-newsurface/keiro-dsl-ledger.context.transfer-routing.txt +44/−0
test/conformance-nominal-scalars/Generated/NominalScalars/BehaviorSourceMap.hs +5/−5
test/conformance-nominal-scalars/Generated/NominalScalars/Nominal/Shape/OrderStatus.hs +1/−1
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/BehaviorContract.hs +110/−106
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Codec.hs +1/−2
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Domain.hs +1/−2
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/EventStream.hs +1/−1
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Harness.hs +1/−1
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Projection.hs +1/−1
test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Transducer.hs +1/−2
test/conformance-nominal-scalars/Generated/NominalScalars/NominalProjections.hs +1/−1
test/conformance-nominal-scalars/Generated/NominalScalars/ReplayAudit.hs +1/−1
test/conformance-nominal-scalars/NominalConformance/Domain.hs +18/−0
test/conformance-nominal-scalars/compile-fail/PartialInverse.hs +12/−0
test/conformance-nominal-scalars/compile-fail/check-partial-inverse.sh +4/−0
test/conformance-nominal-scalars/keiro-dsl-cabal-fragment.context.nominal-scalars.txt +42/−0
test/conformance-nominal-scalars/keiro-dsl-ledger.context.nominal-scalars.txt +67/−0
test/conformance-nominal-scalars/mutations/dishonest-exact.sh +4/−0
test/conformance-nominal-scalars/mutations/enum-transpose.sh +4/−0
test/conformance-nominal-scalars/mutations/id-one-direction.sh +4/−0
test/conformance-nominal-scalars/mutations/scalar-wire.sh +4/−0
test/conformance-process-full/Generated/SurgeDemo/BehaviorSourceMap.hs +5/−5
test/conformance-process-full/Generated/SurgeDemo/Hospital/BehaviorContract.hs +349/−0
test/conformance-process-full/Generated/SurgeDemo/Hospital/Codec.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/Hospital/Domain.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/Hospital/EventStream.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Hospital/Harness.hs +57/−0
test/conformance-process-full/Generated/SurgeDemo/Hospital/Projection.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Hospital/Transducer.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/Nominals.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Nominals/Internal.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/ReplayAudit.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Surge/BehaviorContract.hs +398/−0
test/conformance-process-full/Generated/SurgeDemo/Surge/Codec.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/Surge/Domain.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/Surge/EventStream.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Surge/Harness.hs +61/−0
test/conformance-process-full/Generated/SurgeDemo/Surge/Projection.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/Surge/Transducer.hs +1/−2
test/conformance-process-full/Generated/SurgeDemo/SurgeFlow/Process.hs +1/−1
test/conformance-process-full/Generated/SurgeDemo/SurgeFlow/ProcessHarness.hs +22/−0
test/conformance-process-full/SurgeDemo/Hospital/BehaviorHoles.hs +10/−0
test/conformance-process-full/SurgeDemo/Surge/BehaviorHoles.hs +14/−0
test/conformance-process-full/SurgeDemo/SurgeFlow/Manager.hs +4/−4
test/conformance-process-full/SurgeDemo/SurgeFlow/ProcessHoles.hs +11/−0
test/conformance-process-full/keiro-dsl-cabal-fragment.context.surge-demo.txt +48/−0
test/conformance-process-full/keiro-dsl-ledger.context.surge-demo.txt +68/−0
test/conformance-process-runtime/Generated/HospitalCapacity/BehaviorSourceMap.hs +5/−5
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/BehaviorContract.hs +337/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Codec.hs +66/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Domain.hs +40/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/EventStream.hs +49/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Harness.hs +57/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Projection.hs +4/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Hospital/Transducer.hs +54/−0
test/conformance-process-runtime/Generated/HospitalCapacity/HospitalSurge/Process.hs +1/−1
test/conformance-process-runtime/Generated/HospitalCapacity/HospitalSurge/ProcessHarness.hs +22/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Nominals.hs +1/−1
test/conformance-process-runtime/Generated/HospitalCapacity/Nominals/Internal.hs +1/−1
test/conformance-process-runtime/Generated/HospitalCapacity/ReplayAudit.hs +30/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/BehaviorContract.hs +350/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Codec.hs +1/−2
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Domain.hs +1/−2
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/EventStream.hs +1/−1
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Harness.hs +87/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Projection.hs +4/−0
test/conformance-process-runtime/Generated/HospitalCapacity/Surge/Transducer.hs +1/−2
test/conformance-process-runtime/HospitalCapacity/Hospital/BehaviorHoles.hs +9/−0
test/conformance-process-runtime/HospitalCapacity/Hospital/Holes.hs +33/−0
test/conformance-process-runtime/HospitalCapacity/HospitalSurge/ProcessHoles.hs +11/−0
test/conformance-process-runtime/HospitalCapacity/Surge/BehaviorHoles.hs +10/−0
test/conformance-process-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +46/−0
test/conformance-process-runtime/keiro-dsl-ledger.context.hospital-capacity.txt +61/−0
test/conformance-process/Generated/HospitalCapacity/BehaviorSourceMap.hs +5/−5
test/conformance-process/Generated/HospitalCapacity/Hospital/BehaviorContract.hs +337/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/Codec.hs +66/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/Domain.hs +40/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/EventStream.hs +49/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/Harness.hs +57/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/Projection.hs +4/−0
test/conformance-process/Generated/HospitalCapacity/Hospital/Transducer.hs +54/−0
test/conformance-process/Generated/HospitalCapacity/HospitalSurge/Process.hs +76/−0
test/conformance-process/Generated/HospitalCapacity/HospitalSurge/ProcessHarness.hs +1/−1
test/conformance-process/Generated/HospitalCapacity/Nominals.hs +13/−0
test/conformance-process/Generated/HospitalCapacity/Nominals/Internal.hs +70/−0
test/conformance-process/Generated/HospitalCapacity/ReplayAudit.hs +30/−0
test/conformance-process/Generated/HospitalCapacity/Surge/BehaviorContract.hs +350/−0
test/conformance-process/Generated/HospitalCapacity/Surge/Codec.hs +85/−0
test/conformance-process/Generated/HospitalCapacity/Surge/Domain.hs +61/−0
test/conformance-process/Generated/HospitalCapacity/Surge/EventStream.hs +49/−0
test/conformance-process/Generated/HospitalCapacity/Surge/Harness.hs +87/−0
test/conformance-process/Generated/HospitalCapacity/Surge/Projection.hs +4/−0
test/conformance-process/Generated/HospitalCapacity/Surge/Transducer.hs +64/−0
test/conformance-process/HospitalCapacity/Hospital/BehaviorHoles.hs +9/−0
test/conformance-process/HospitalCapacity/Hospital/Holes.hs +37/−0
test/conformance-process/HospitalCapacity/HospitalSurge/ProcessHoles.hs +11/−0
test/conformance-process/HospitalCapacity/Surge/BehaviorHoles.hs +10/−0
test/conformance-process/HospitalCapacity/Surge/Holes.hs +37/−0
test/conformance-process/keiro-dsl-cabal-fragment.context.hospital-capacity.txt +46/−0
test/conformance-process/keiro-dsl-ledger.context.hospital-capacity.txt +61/−0
test/conformance-projection-catalog/Generated/CatalogDemo/BehaviorSourceMap.hs +5/−5
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModel.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModelHarness.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/CatalogAudit/ReadModelTable.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/QueryContract.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModel.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModelHarness.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/OrderInline/ReadModelTable.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModel.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModelHarness.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/OrderTotalsLookup/ReadModelTable.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/BehaviorContract.hs +110/−106
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Codec.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Domain.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/EventStream.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Harness.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Projection.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/Orders/Transducer.hs +1/−2
test/conformance-projection-catalog/Generated/CatalogDemo/ProjectionCatalog.hs +1/−1
test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/Queue.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/QueueCodec.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/QualificationJobs/QueuePolicy.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/ReplayAudit.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModel.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModelHarness.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/ShipmentLookup/ReadModelTable.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/BehaviorContract.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Codec.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Domain.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/EventStream.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Harness.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Projection.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Shipments/Transducer.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/Structural/Shape/QualificationPayload.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/StructuralConformance.hs too large to diff
test/conformance-projection-catalog/Generated/CatalogDemo/StructuralProjections.hs too large to diff
test/conformance-projection-catalog/Main.hs too large to diff
test/conformance-projection-catalog/keiro-dsl-cabal-fragment.context.catalog-demo.txt too large to diff
test/conformance-projection-catalog/keiro-dsl-ledger.context.catalog-demo.txt too large to diff
test/conformance-publisher-runtime/Generated/HospitalCapacity/Emergency/Contract.hs too large to diff
test/conformance-publisher-runtime/Generated/HospitalCapacity/HospitalPublisher/Publisher.hs too large to diff
test/conformance-publisher-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-publisher-runtime/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/Queue.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs too large to diff
test/conformance-queue-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs too large to diff
test/conformance-queue-runtime/HospitalCapacity/AcceptedTransferNeeds/ReadModelHoles.hs too large to diff
test/conformance-queue-runtime/HospitalCapacity/TransferDecisions/ReadModelHoles.hs too large to diff
test/conformance-queue-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-queue-runtime/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModel.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelHarness.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/AcceptedTransferNeeds/ReadModelTable.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/ReservationWork/Queue.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/ReservationWork/QueueCodec.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/ReservationWork/QueuePolicy.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs too large to diff
test/conformance-queue/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs too large to diff
test/conformance-queue/HospitalCapacity/AcceptedTransferNeeds/ReadModelHoles.hs too large to diff
test/conformance-queue/HospitalCapacity/TransferDecisions/ReadModelHoles.hs too large to diff
test/conformance-queue/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-queue/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModel.hs too large to diff
test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelHarness.hs too large to diff
test/conformance-readmodel-runtime/Generated/HospitalCapacity/TransferDecisions/ReadModelTable.hs too large to diff
test/conformance-readmodel-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-readmodel-runtime/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-replay/Generated/ReplayDivergence/BehaviorSourceMap.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/BehaviorContract.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/Codec.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/Domain.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/EventStream.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/Harness.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/Projection.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/Note/Transducer.hs too large to diff
test/conformance-replay/Generated/ReplayDivergence/ReplayAudit.hs too large to diff
test/conformance-replay/ReplayDivergence/Note/BehaviorHoles.hs too large to diff
test/conformance-replay/keiro-dsl-cabal-fragment.context.replay-divergence.txt too large to diff
test/conformance-replay/keiro-dsl-ledger.context.replay-divergence.txt too large to diff
test/conformance-router-full/Generated/IncidentPaging/BehaviorSourceMap.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/BehaviorContract.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/Codec.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/Domain.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/EventStream.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/Harness.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/Projection.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/Page/Transducer.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/PagingRouter/Router.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/PagingRouter/RouterHarness.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/ReplayAudit.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModel.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs too large to diff
test/conformance-router-full/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs too large to diff
test/conformance-router-full/IncidentPaging/Page/BehaviorHoles.hs too large to diff
test/conformance-router-full/IncidentPaging/PagingRouter/RouterHoles.hs too large to diff
test/conformance-router-full/IncidentPaging/ServiceOncall/ReadModelHoles.hs too large to diff
test/conformance-router-full/keiro-dsl-cabal-fragment.context.incident-paging.txt too large to diff
test/conformance-router-full/keiro-dsl-ledger.context.incident-paging.txt too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/BehaviorSourceMap.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/BehaviorContract.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/Codec.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/Domain.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/EventStream.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/Harness.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/Projection.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/Page/Transducer.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/PagingRouter/Router.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/PagingRouter/RouterHarness.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/ReplayAudit.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModel.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs too large to diff
test/conformance-router-runtime/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs too large to diff
test/conformance-router-runtime/IncidentPaging/Page/BehaviorHoles.hs too large to diff
test/conformance-router-runtime/IncidentPaging/Page/Holes.hs too large to diff
test/conformance-router-runtime/IncidentPaging/PagingRouter/RouterHoles.hs too large to diff
test/conformance-router-runtime/IncidentPaging/ServiceOncall/ReadModelHoles.hs too large to diff
test/conformance-router-runtime/keiro-dsl-cabal-fragment.context.incident-paging.txt too large to diff
test/conformance-router-runtime/keiro-dsl-ledger.context.incident-paging.txt too large to diff
test/conformance-router/Generated/IncidentPaging/BehaviorSourceMap.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/BehaviorContract.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/Codec.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/Domain.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/EventStream.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/Harness.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/Projection.hs too large to diff
test/conformance-router/Generated/IncidentPaging/Page/Transducer.hs too large to diff
test/conformance-router/Generated/IncidentPaging/PagingRouter/Router.hs too large to diff
test/conformance-router/Generated/IncidentPaging/PagingRouter/RouterHarness.hs too large to diff
test/conformance-router/Generated/IncidentPaging/ReplayAudit.hs too large to diff
test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModel.hs too large to diff
test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModelHarness.hs too large to diff
test/conformance-router/Generated/IncidentPaging/ServiceOncall/ReadModelTable.hs too large to diff
test/conformance-router/IncidentPaging/Page/BehaviorHoles.hs too large to diff
test/conformance-router/IncidentPaging/Page/Holes.hs too large to diff
test/conformance-router/IncidentPaging/PagingRouter/RouterHoles.hs too large to diff
test/conformance-router/IncidentPaging/ServiceOncall/ReadModelHoles.hs too large to diff
test/conformance-router/keiro-dsl-cabal-fragment.context.incident-paging.txt too large to diff
test/conformance-router/keiro-dsl-ledger.context.incident-paging.txt too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/BehaviorSourceMap.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Nominals.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Nominals/Internal.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ReplayAudit.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/BehaviorContract.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Codec.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Domain.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/EventStream.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Harness.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Projection.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/ScalarAccount/Transducer.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/Structural/Shape/Limits.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/StructuralConformance.hs too large to diff
test/conformance-scalar-expressions/Generated/AggregateScalarExpressions/StructuralProjections.hs too large to diff
test/conformance-scalar-expressions/Main.hs too large to diff
test/conformance-scalar-expressions/keiro-dsl-cabal-fragment.context.aggregate-scalar-expressions.txt too large to diff
test/conformance-scalar-expressions/keiro-dsl-ledger.context.aggregate-scalar-expressions.txt too large to diff
test/conformance-service-package/domain/alpha.keiro too large to diff
test/conformance-service-package/domain/beta.keiro too large to diff
test/conformance-service-package/domain/evidence.keiro too large to diff
test/conformance-service-package/domain/shared.keiro too large to diff
test/conformance-service-package/runtime/keiro-dsl-conformance-service-runtime.cabal too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/BehaviorHoles.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/BehaviorContract.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Codec.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Domain.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/EventStream.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Harness.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Projection.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Alpha/Generated/Transducer.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModel.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModelHarness.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/Generated/ReadModelTable.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/AlphaView/ReadModelHoles.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/BehaviorHoles.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/BehaviorContract.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Codec.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Domain.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/EventStream.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Harness.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Projection.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Beta/Generated/Transducer.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModel.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModelHarness.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/Generated/ReadModelTable.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/BetaView/ReadModelHoles.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/BehaviorSourceMap.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Conformance.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Nominals.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/Nominals/Internal.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/Generated/ReplayAudit.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/WorkspaceProofWorkflow/Generated/WorkflowFacts.hs too large to diff
test/conformance-service-package/runtime/src/Proof/WorkspaceProof/WorkspaceProofWorkflow/Generated/WorkflowRuntime.hs too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-cabal-fragment.workspace.workspace-proof.txt too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/keiro-dsl-conformance-ledger.txt too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/keiro-workspace-proof-conformance.cabal too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/src/KeiroConformance/Expectations.hs too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-conformance.workspace.workspace-proof/src/Main.hs too large to diff
test/conformance-service-package/runtime/src/keiro-dsl-ledger.workspace.workspace-proof.txt too large to diff
test/conformance-service-package/service.keiro-workspace too large to diff
test/conformance-skeletons/Main.hs too large to diff
test/conformance-skeletons/SkelAggregate/Generated/MyService/Thing/BehaviorContract.hs too large to diff
test/conformance-skeletons/SkelAggregate/keiro-dsl-manifest.my-service.txt too large to diff
test/conformance-skeletons/SkelAggregate/keiro-dsl-scaffold-record.my-service.txt too large to diff
test/conformance-skeletons/SkelIntake/Generated/MyService/ThingInbox/Inbox.hs too large to diff
test/conformance-skeletons/SkelProcess/Generated/MyService/Hospital/BehaviorContract.hs too large to diff
test/conformance-skeletons/SkelProcess/Generated/MyService/Surge/BehaviorContract.hs too large to diff
test/conformance-skeletons/SkelProcess/MyService/Hospital/BehaviorHoles.hs too large to diff
test/conformance-skeletons/SkelProcess/MyService/Surge/BehaviorHoles.hs too large to diff
test/conformance-skeletons/SkelRouter/Generated/MyService/Page/BehaviorContract.hs too large to diff
test/conformance-skeletons/SkelRouter/MyService/Page/BehaviorHoles.hs too large to diff
test/conformance-skeletons/SkelWorkflow/Generated/MyService/HospitalTransferReservation/WorkflowFacts.hs too large to diff
test/conformance-skeletons/keiro-dsl-cabal-fragment.context.my-service.txt too large to diff
test/conformance-skeletons/keiro-dsl-ledger.context.my-service.txt too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/BehaviorSourceMap.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Nominals.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Nominals/Internal.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/ReplayAudit.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/BehaviorContract.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Codec.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Domain.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/EventStream.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Harness.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Projection.hs too large to diff
test/conformance-snapshot/Generated/HospitalCapacity/Reservation/Transducer.hs too large to diff
test/conformance-snapshot/HospitalCapacity/Reservation/BehaviorHoles.hs too large to diff
test/conformance-snapshot/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-snapshot/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/BehaviorContract.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Codec.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Domain.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/EventStream.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Harness.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Projection.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Transducer.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/BehaviorSourceMap.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/ReplayAudit.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/Structural/CodecCompare/ArtifactInfo.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactInfo.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactKind.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactLocation.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/Structural/Shape/ArtifactMetadata.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/StructuralConformance.hs too large to diff
test/conformance-structural/Generated/StructuralConformance/StructuralProjections.hs too large to diff
test/conformance-structural/StructuralConformance/ArtifactCatalog/BehaviorHoles.hs too large to diff
test/conformance-structural/keiro-dsl-cabal-fragment.context.structural-conformance.txt too large to diff
test/conformance-structural/keiro-dsl-ledger.context.structural-conformance.txt too large to diff
test/conformance-v2/Generated/HospitalCapacity/BehaviorSourceMap.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Nominals.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Nominals/Internal.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/ReplayAudit.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/BehaviorContract.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/Codec.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/Domain.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/EventStream.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/Harness.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/Projection.hs too large to diff
test/conformance-v2/Generated/HospitalCapacity/Reservation/Transducer.hs too large to diff
test/conformance-v2/HospitalCapacity/Reservation/BehaviorHoles.hs too large to diff
test/conformance-v2/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-v2/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-workflow-full/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs too large to diff
test/conformance-workflow-full/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs too large to diff
test/conformance-workflow-full/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-workflow-full/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-workflow-runtime/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs too large to diff
test/conformance-workflow-runtime/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs too large to diff
test/conformance-workflow-runtime/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-workflow-runtime/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-workflow/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowFacts.hs too large to diff
test/conformance-workflow/Generated/HospitalCapacity/HospitalTransferReservation/WorkflowRuntime.hs too large to diff
test/conformance-workflow/Main.hs too large to diff
test/conformance-workflow/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance-workflow/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/BehaviorSourceMap.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Nominals.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Nominals/Internal.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/BehaviorContract.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Codec.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Domain.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/EventStream.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Harness.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Projection.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/Project/Transducer.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/BehaviorContract.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Codec.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Domain.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/EventStream.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Harness.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Projection.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ProjectArtifact/Transducer.hs too large to diff
test/conformance-workspace-nominals/Generated/WorkspaceNominalProof/ReplayAudit.hs too large to diff
test/conformance-workspace-nominals/keiro-dsl-cabal-fragment.workspace.workspace-nominal-proof.txt too large to diff
test/conformance-workspace-nominals/keiro-dsl-ledger.workspace.workspace-nominal-proof.txt too large to diff
test/conformance/Generated/HospitalCapacity/BehaviorSourceMap.hs too large to diff
test/conformance/Generated/HospitalCapacity/Nominals.hs too large to diff
test/conformance/Generated/HospitalCapacity/Nominals/Internal.hs too large to diff
test/conformance/Generated/HospitalCapacity/ReplayAudit.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/BehaviorContract.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/Codec.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/Domain.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/EventStream.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/Harness.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/Projection.hs too large to diff
test/conformance/Generated/HospitalCapacity/Reservation/Transducer.hs too large to diff
test/conformance/HospitalCapacity/Reservation/BehaviorHoles.hs too large to diff
test/conformance/keiro-dsl-cabal-fragment.context.hospital-capacity.txt too large to diff
test/conformance/keiro-dsl-ledger.context.hospital-capacity.txt too large to diff
test/diff-test.sh too large to diff
test/domain-command-outcome-mutation-test.sh too large to diff
test/fixtures/aggregate-bad-refs.keiro too large to diff
test/fixtures/aggregate-collection-expressions-v2-rejects.keiro too large to diff
test/fixtures/aggregate-field-alias.keiro too large to diff
test/fixtures/aggregate-scalar-expressions-v1-rejects.keiro too large to diff
test/fixtures/aggregate-scalar-expressions-v2.keiro too large to diff
test/fixtures/aggregate-scalars-arithmetic.keiro too large to diff
test/fixtures/aggregate-scalars-invalid-capabilities.keiro too large to diff
test/fixtures/aggregate-scalars-unsupported.keiro too large to diff
test/fixtures/aggregate-scalars-workspace/domain/scalars.keiro too large to diff
test/fixtures/aggregate-scalars-workspace/service.keiro-workspace too large to diff
test/fixtures/aggregate-scalars.keiro too large to diff
test/fixtures/behavior-complete-workspace/declarations.keiro too large to diff
test/fixtures/behavior-complete-workspace/journey.keiro too large to diff
test/fixtures/behavior-complete-workspace/service.keiro-workspace too large to diff
test/fixtures/behavior-complete.keiro too large to diff
test/fixtures/catalog-readmodel-backing-required.keiro too large to diff
test/fixtures/catalog-readmodel-backing-unobserved.keiro too large to diff
test/fixtures/catalog-readmodel-physical-override.keiro too large to diff
test/fixtures/catalog-readmodel-reorder-a.keiro too large to diff
test/fixtures/catalog-readmodel-reorder-b.keiro too large to diff
test/fixtures/check-report/legacy-min-language.golden.json too large to diff
test/fixtures/compatibility-vector-new.keiro too large to diff
test/fixtures/compatibility-vector-old.keiro too large to diff
test/fixtures/compatibility-vector.diff.golden too large to diff
test/fixtures/consumer-types-armadd.keiro too large to diff
test/fixtures/consumer-types-binding-change.keiro too large to diff
test/fixtures/consumer-types-encoding.keiro too large to diff
test/fixtures/consumer-types-enumadd.keiro too large to diff
test/fixtures/consumer-types-enumremove.keiro too large to diff
test/fixtures/consumer-types-enumspelling.keiro too large to diff
test/fixtures/consumer-types-fieldadd-default.keiro too large to diff
test/fixtures/consumer-types-fieldadd-nodefault.keiro too large to diff
test/fixtures/consumer-types-fieldremove.keiro too large to diff
test/fixtures/consumer-types-fixtures-change.keiro too large to diff
test/fixtures/consumer-types-haskell-rename.keiro too large to diff
test/fixtures/consumer-types-initial-change.keiro too large to diff
test/fixtures/consumer-types-mode-cross.keiro too large to diff
test/fixtures/consumer-types-nested-propagation.keiro too large to diff
test/fixtures/consumer-types-opaque-version.keiro too large to diff
test/fixtures/consumer-types-tagchange.keiro too large to diff
test/fixtures/consumer-types-v2.keiro too large to diff
test/fixtures/consumer-types-wirekey.keiro too large to diff
test/fixtures/consumer-types.keiro too large to diff
test/fixtures/contract-bump-fieldadd.keiro too large to diff
test/fixtures/contract-discriminator.keiro too large to diff
test/fixtures/contract-eventadd.keiro too large to diff
test/fixtures/contract-eventdrop.keiro too large to diff
test/fixtures/contract-fieldadd.keiro too large to diff
test/fixtures/contract-fieldtype.keiro too large to diff
test/fixtures/contract-reserved-family.keiro too large to diff
test/fixtures/contract-topic.keiro too large to diff
test/fixtures/contract-typeid-domain.diff.golden too large to diff
test/fixtures/contract-typeid-domain.diff.json.golden too large to diff
test/fixtures/contract-v1-compat.keiro too large to diff
test/fixtures/contract-v4.keiro too large to diff
test/fixtures/contract.keiro too large to diff
test/fixtures/declarative-router/README.md too large to diff
test/fixtures/declarative-router/unbounded.keiro too large to diff
test/fixtures/declarative-router/valid.keiro too large to diff
test/fixtures/deny-unlogged.keiro too large to diff
test/fixtures/dispatch-dedup-bad-field.keiro too large to diff
test/fixtures/dispatch-dedup-ghost-queue.keiro too large to diff
test/fixtures/domain-command-outcomes.keiro too large to diff
test/fixtures/duplicate-names.keiro too large to diff
test/fixtures/emit-badevent.keiro too large to diff
test/fixtures/emit-derive.keiro too large to diff
test/fixtures/emit-mapchange.keiro too large to diff
test/fixtures/emit-noskip.keiro too large to diff
test/fixtures/emit-ordering.keiro too large to diff
test/fixtures/emit-outboxfield.keiro too large to diff
test/fixtures/emit-topic-mismatch.keiro too large to diff
test/fixtures/emit.keiro too large to diff
test/fixtures/fold-identity-baseline.golden too large to diff
test/fixtures/fold-identity-diff-replay.golden too large to diff
test/fixtures/hospital-surge-badref.keiro too large to diff
test/fixtures/hospital-surge-clock.keiro too large to diff
test/fixtures/hospital-surge-dispatchid.keiro too large to diff
test/fixtures/hospital-surge-handle.keiro too large to diff
test/fixtures/hospital-surge-inputtype.keiro too large to diff
test/fixtures/hospital-surge-payload.keiro too large to diff
test/fixtures/hospital-surge-procname.keiro too large to diff
test/fixtures/hospital-surge-timerid.keiro too large to diff
test/fixtures/hospital-surge-window.keiro too large to diff
test/fixtures/hospital-surge.keiro too large to diff
test/fixtures/id-domain-migration-v3.keiro too large to diff
test/fixtures/import-planning-collisions.keiro too large to diff
test/fixtures/incident-paging/incident-paging-dispatch.keiro too large to diff
test/fixtures/incident-paging/incident-paging.keiro too large to diff
test/fixtures/intake-decode.keiro too large to diff
test/fixtures/intake-dedupekey.keiro too large to diff
test/fixtures/intake-dedupepolicy.keiro too large to diff
test/fixtures/intake-dup-retry.keiro too large to diff
test/fixtures/intake-dup-row.keiro too large to diff
test/fixtures/intake-incomplete.keiro too large to diff
test/fixtures/intake-pf-retry.keiro too large to diff
test/fixtures/intake-topic-mismatch.keiro too large to diff
test/fixtures/intake.keiro too large to diff
test/fixtures/language-duplicate.keiro too large to diff
test/fixtures/language-identifier-v1.keiro too large to diff
test/fixtures/language-identifier-v2.keiro too large to diff
test/fixtures/language-legacy.keiro too large to diff
test/fixtures/language-malformed.keiro too large to diff
test/fixtures/language-misplaced.keiro too large to diff
test/fixtures/language-v1.keiro too large to diff
test/fixtures/language-zero.keiro too large to diff
test/fixtures/mapped-ambiguous.keiro too large to diff
test/fixtures/mapped-bad-encoding.keiro too large to diff
test/fixtures/mapped-bad-haskell-name.keiro too large to diff
test/fixtures/mapped-dup-armname.keiro too large to diff
test/fixtures/mapped-dup-fieldname.keiro too large to diff
test/fixtures/mapped-dup-tag.keiro too large to diff
test/fixtures/mapped-dup-wirekey.keiro too large to diff
test/fixtures/mapped-empty-identity.keiro too large to diff
test/fixtures/mapped-guard-natural.keiro too large to diff
test/fixtures/mapped-guard-time.keiro too large to diff
test/fixtures/mapped-guard.keiro too large to diff
test/fixtures/mapped-illtyped-default.keiro too large to diff
test/fixtures/mapped-import-conflict.keiro too large to diff
test/fixtures/mapped-missing-binding-version.keiro too large to diff
test/fixtures/mapped-missing-binding.keiro too large to diff
test/fixtures/mapped-missing-canonical.keiro too large to diff
test/fixtures/mapped-missing-fixture.keiro too large to diff
test/fixtures/mapped-missing-initial.keiro too large to diff
test/fixtures/mapped-optional-json.keiro too large to diff
test/fixtures/mapped-optional-opaque.keiro too large to diff
test/fixtures/mapped-optional-optional.keiro too large to diff
test/fixtures/mapped-readmodel-workspace/readmodel.keiro too large to diff
test/fixtures/mapped-readmodel-workspace/service.keiro-workspace too large to diff
test/fixtures/mapped-readmodel-workspace/types.keiro too large to diff
test/fixtures/mapped-readmodel.keiro too large to diff
test/fixtures/mapped-recursive-mutual.keiro too large to diff
test/fixtures/mapped-recursive.keiro too large to diff
test/fixtures/mapped-union-key-collision.keiro too large to diff
test/fixtures/mapped-unresolved.keiro too large to diff
test/fixtures/mapped-workqueue.keiro too large to diff
test/fixtures/nominal-bad-qualified.keiro too large to diff
test/fixtures/nominal-invalid-prefix.keiro too large to diff
test/fixtures/nominal-missing-facts.keiro too large to diff
test/fixtures/nominal-missing-initial.keiro too large to diff
test/fixtures/nominal-name-collision.keiro too large to diff
test/fixtures/nominal-scalars.keiro too large to diff
test/fixtures/nominal-unsupported-representation.keiro too large to diff
test/fixtures/nominal-v1.keiro too large to diff
test/fixtures/operation-ghost-aggregate.keiro too large to diff
test/fixtures/operation-signal-value.keiro too large to diff
test/fixtures/order.keiro too large to diff
test/fixtures/outcome-identifier-legacy.keiro too large to diff
test/fixtures/outcome-identifier-positions.keiro too large to diff
test/fixtures/outcome-identifier-v5.keiro too large to diff
test/fixtures/outcome-identifier.keiro too large to diff
test/fixtures/process-bad-timer.keiro too large to diff
test/fixtures/process-ghost-refs.keiro too large to diff
test/fixtures/projection-catalog-grown.keiro-workspace too large to diff
test/fixtures/projection-catalog-unrelated.keiro too large to diff
test/fixtures/projection-catalog.keiro too large to diff
test/fixtures/projection-catalog.keiro-workspace too large to diff
test/fixtures/projection-owner-multi-query.keiro too large to diff
test/fixtures/readmodel-consistency-conflict.keiro too large to diff
test/fixtures/readmodel-dispatch-unresolved.keiro too large to diff
test/fixtures/readmodel-inline-unreferenced.keiro too large to diff
test/fixtures/readmodel-migration-l4.keiro too large to diff
test/fixtures/readmodel-query-unresolved.keiro too large to diff
test/fixtures/readmodel-runtime.keiro too large to diff
test/fixtures/readmodel-scope-eventual.keiro too large to diff
test/fixtures/readmodel-shape-drift.keiro too large to diff
test/fixtures/readmodel-strong-inline.keiro too large to diff
test/fixtures/readmodel-strong-standalone.keiro too large to diff
test/fixtures/readmodel.keiro too large to diff
test/fixtures/record-migration/behavior-obligations.exact.json.golden too large to diff
test/fixtures/record-migration/single-file-scaffold-record.ledger.golden too large to diff
test/fixtures/record-migration/workspace-scaffold-record.ledger.golden too large to diff
test/fixtures/replay-divergence.keiro too large to diff
test/fixtures/reservation-bad-command.keiro too large to diff
test/fixtures/reservation-chain-gap.keiro too large to diff
test/fixtures/reservation-clock.keiro too large to diff
test/fixtures/reservation-cmdfieldtype.keiro too large to diff
test/fixtures/reservation-deprecated-replay-only.keiro too large to diff
test/fixtures/reservation-deprecated.keiro too large to diff
test/fixtures/reservation-dup-upcast-source.keiro too large to diff
test/fixtures/reservation-enumadd.keiro too large to diff
test/fixtures/reservation-enumdrop.keiro too large to diff
test/fixtures/reservation-enumwire.keiro too large to diff
test/fixtures/reservation-fieldadd.keiro too large to diff
test/fixtures/reservation-fieldremove.keiro too large to diff
test/fixtures/reservation-fieldtype.keiro too large to diff
test/fixtures/reservation-foldchange.keiro too large to diff
test/fixtures/reservation-guard-tightened-twin.keiro too large to diff
test/fixtures/reservation-guard-tightened.keiro too large to diff
test/fixtures/reservation-idprefix.keiro too large to diff
test/fixtures/reservation-no-statusmap.keiro too large to diff
test/fixtures/reservation-projection.keiro too large to diff
test/fixtures/reservation-retiring.keiro too large to diff
test/fixtures/reservation-snapshot.keiro too large to diff
test/fixtures/reservation-v2-noupcast.keiro too large to diff
test/fixtures/reservation-v2.keiro too large to diff
test/fixtures/reservation-v3-dangling.keiro too large to diff
test/fixtures/reservation-wire.keiro too large to diff
test/fixtures/reservation-work-dedupkey.keiro too large to diff
test/fixtures/reservation-work-df-retry.keiro too large to diff
test/fixtures/reservation-work-divergent.keiro too large to diff
test/fixtures/reservation-work-fieldtype.keiro too large to diff
test/fixtures/reservation-work-fifo-nokey.keiro too large to diff
test/fixtures/reservation-work-key-unordered.keiro too large to diff
test/fixtures/reservation-work-optfield.keiro too large to diff
test/fixtures/reservation-work-partitioned-empty.keiro too large to diff
test/fixtures/reservation-work-rename.keiro too large to diff
test/fixtures/reservation-work-reqfield.keiro too large to diff
test/fixtures/reservation-work-retarget.keiro too large to diff
test/fixtures/reservation-work-sf-deadletter.keiro too large to diff
test/fixtures/reservation-work-unlogged.keiro too large to diff
test/fixtures/reservation-work-wirename.keiro too large to diff
test/fixtures/reservation-work.keiro too large to diff
test/fixtures/reservation.keiro too large to diff
test/fixtures/rule-bad-domain.keiro too large to diff
test/fixtures/rule-not-total.keiro too large to diff
test/fixtures/semantic-impact.keiro too large to diff
test/fixtures/semantic-locality/domain/alpha.keiro too large to diff
test/fixtures/semantic-locality/domain/beta.keiro too large to diff
test/fixtures/semantic-locality/service.keiro-workspace too large to diff
test/fixtures/statusmap-dangling.keiro too large to diff
test/fixtures/statusmap-dup-key.keiro too large to diff
test/fixtures/structural-conformance.keiro too large to diff
test/fixtures/structural-locality.keiro too large to diff
test/fixtures/structural-locality.keiro-workspace too large to diff
test/fixtures/subscription.keiro too large to diff
test/fixtures/surge-service.keiro too large to diff
test/fixtures/transfer-routing.keiro too large to diff
test/fixtures/workflow-body.keiro too large to diff
test/fixtures/workflow-can-mid.keiro too large to diff
test/fixtures/workflow-continue-seed-v2.keiro too large to diff
test/fixtures/workflow-continue.keiro too large to diff
test/fixtures/workflow-dup-label.keiro too large to diff
test/fixtures/workflow-evolution-diff.keiro too large to diff
test/fixtures/workflow-evolution.keiro too large to diff
test/fixtures/workflow-idfield.keiro too large to diff
test/fixtures/workflow-inputfield.keiro too large to diff
test/fixtures/workflow-output.keiro too large to diff
test/fixtures/workflow-patch-colon.keiro too large to diff
test/fixtures/workflow-patch-dup.keiro too large to diff
test/fixtures/workflow-rename.keiro too large to diff
test/fixtures/workflow-signal-mismatch.keiro too large to diff
test/fixtures/workflow-stepadd.keiro too large to diff
test/fixtures/workflow-unresolved-fields.keiro too large to diff
test/fixtures/workflow.keiro too large to diff
test/fixtures/workqueue-dlq-divergent.keiro too large to diff
test/fixtures/workqueue-dup-row.keiro too large to diff
test/fixtures/workqueue-group-key-change.keiro too large to diff
test/fixtures/workqueue-hashed-logical.keiro too large to diff
test/fixtures/workqueue-incomplete.keiro too large to diff
test/fixtures/workqueue-ordering-change.keiro too large to diff
test/fixtures/workqueue-policy-base.keiro too large to diff
test/fixtures/workqueue-provision-change.keiro too large to diff
test/fixtures/workqueue-table-divergent.keiro too large to diff
test/fixtures/workqueue-uppercase-logical.keiro too large to diff
test/fixtures/workspace-authority-conflict/domain/a.keiro too large to diff
test/fixtures/workspace-authority-conflict/domain/b.keiro too large to diff
test/fixtures/workspace-authority-conflict/service.keiro-workspace too large to diff
test/fixtures/workspace-context-mismatch/domain/a.keiro too large to diff
test/fixtures/workspace-context-mismatch/domain/b.keiro too large to diff
test/fixtures/workspace-context-mismatch/service.keiro-workspace too large to diff
test/fixtures/workspace-diff-moved/domain/order.keiro too large to diff
test/fixtures/workspace-diff-moved/domain/shared.keiro too large to diff
test/fixtures/workspace-diff-moved/service.keiro-workspace too large to diff
test/fixtures/workspace-diff-new/domain/order.keiro too large to diff
test/fixtures/workspace-diff-new/domain/shared.keiro too large to diff
test/fixtures/workspace-diff-new/domain/shipment.keiro too large to diff
test/fixtures/workspace-diff-new/service.keiro-workspace too large to diff
test/fixtures/workspace-diff-new/workspace.diff.golden too large to diff
test/fixtures/workspace-diff-old/domain/order.keiro too large to diff
test/fixtures/workspace-diff-old/domain/shared.keiro too large to diff
test/fixtures/workspace-diff-old/domain/shipment.keiro too large to diff
test/fixtures/workspace-diff-old/service.keiro-workspace too large to diff
test/fixtures/workspace-dup-decl/domain/project.keiro too large to diff
test/fixtures/workspace-dup-decl/domain/shared.keiro too large to diff
test/fixtures/workspace-dup-decl/service.keiro-workspace too large to diff
test/fixtures/workspace-dup-member/domain/a.keiro too large to diff
test/fixtures/workspace-dup-member/service.keiro-workspace too large to diff
test/fixtures/workspace-dup-node/domain/a.keiro too large to diff
test/fixtures/workspace-dup-node/domain/b.keiro too large to diff
test/fixtures/workspace-dup-node/service.keiro-workspace too large to diff
test/fixtures/workspace-invalid-member-path/service.keiro-workspace too large to diff
test/fixtures/workspace-member-parse-failed/domain/a.keiro too large to diff
test/fixtures/workspace-member-parse-failed/domain/b.keiro too large to diff
test/fixtures/workspace-member-parse-failed/service.keiro-workspace too large to diff
test/fixtures/workspace-missing-member/domain/a.keiro too large to diff
test/fixtures/workspace-missing-member/service.keiro-workspace too large to diff
test/fixtures/workspace-nominals/domain/project-artifact.keiro too large to diff
test/fixtures/workspace-nominals/domain/project.keiro too large to diff
test/fixtures/workspace-nominals/domain/shared.keiro too large to diff
test/fixtures/workspace-nominals/service.keiro-workspace too large to diff
test/fixtures/workspace-path-collision/domain/a.keiro too large to diff
test/fixtures/workspace-path-collision/domain/b.keiro too large to diff
test/fixtures/workspace-path-collision/service.keiro-workspace too large to diff
test/fixtures/workspace-unresolved/domain/project.keiro too large to diff
test/fixtures/workspace-unresolved/domain/shared.keiro too large to diff
test/fixtures/workspace-unresolved/service.keiro-workspace too large to diff
test/fixtures/workspace/domain/project-artifact.keiro too large to diff
test/fixtures/workspace/domain/project.keiro too large to diff
test/fixtures/workspace/domain/shared.keiro too large to diff
test/fixtures/workspace/service-reordered.keiro-workspace too large to diff
test/fixtures/workspace/service.keiro-workspace too large to diff
test/frontend-0.7/diagnostics/duplicate-clause.txt too large to diff
test/frontend-0.7/diagnostics/duplicate-preamble.txt too large to diff
test/frontend-0.7/diagnostics/escaped-string.txt too large to diff
test/frontend-0.7/diagnostics/expression-error.txt too large to diff
test/frontend-0.7/diagnostics/feature-explicit-implementation-v1.txt too large to diff
test/frontend-0.7/diagnostics/feature-integer-v1.txt too large to diff
test/frontend-0.7/diagnostics/feature-nominal-binding-v1.txt too large to diff
test/frontend-0.7/diagnostics/feature-typed-expression-v1.txt too large to diff
test/frontend-0.7/diagnostics/invalid-preamble.txt too large to diff
test/frontend-0.7/diagnostics/misplaced-preamble.txt too large to diff
test/frontend-0.7/diagnostics/numeric-overflow.txt too large to diff
test/frontend-0.7/diagnostics/semantic-error.txt too large to diff
test/frontend-0.7/diagnostics/workspace-member-parse-failure.txt too large to diff
test/frontend-0.7/manifest.json too large to diff
test/frontend-0.7/sources/body-grammar-invalid.keiro too large to diff
test/frontend-0.7/sources/feature-explicit-implementation-v1.keiro too large to diff
test/frontend-0.7/sources/feature-integer-v1.keiro too large to diff
test/frontend-0.7/sources/feature-nominal-binding-v1.keiro too large to diff
test/frontend-0.7/sources/feature-typed-expression-v1.keiro too large to diff
test/frontend-0.7/sources/language-duplicate.keiro too large to diff
test/frontend-0.7/sources/language-legacy.keiro too large to diff
test/frontend-0.7/sources/language-malformed.keiro too large to diff
test/frontend-0.7/sources/language-misplaced.keiro too large to diff
test/frontend-0.7/sources/language-v1.keiro too large to diff
test/frontend-0.7/sources/language-v2.keiro too large to diff
test/frontend-0.7/sources/language-v3.keiro too large to diff
test/frontend-0.7/sources/language-zero.keiro too large to diff
test/frontend-0.7/sources/semantic-invalid.keiro too large to diff
test/frontend-0.7/workspaces/member-parse-failed/domain/a.keiro too large to diff
test/frontend-0.7/workspaces/member-parse-failed/domain/b.keiro too large to diff
test/frontend-0.7/workspaces/member-parse-failed/service.keiro-workspace too large to diff
test/frontend-0.7/workspaces/valid/domain/project-artifact.keiro too large to diff
test/frontend-0.7/workspaces/valid/domain/project.keiro too large to diff
test/frontend-0.7/workspaces/valid/domain/shared.keiro too large to diff
test/frontend-0.7/workspaces/valid/service.keiro-workspace too large to diff
test/golden-payloads/hospital-capacity/Reservation/TransferReservationCreated.v1.json too large to diff
test/golden-payloads/structural-conformance/ArtifactCatalog/ArtifactRecorded.v1.json too large to diff
test/haskell-name/Main.hs too large to diff
test/id-domain-migration-mutation-test.sh too large to diff
test/import-planning/Main.hs too large to diff
test/keiro-dsl-codec-compare-artifact-info.cabal too large to diff
test/mapped-queue-mutation-test.sh too large to diff
test/mapped-readmodel-mutation-test.sh too large to diff
test/mapped-surface-locality-test.sh too large to diff
test/mapped-surface-mutation-test.sh too large to diff
test/mutation-test.sh too large to diff
test/process-mutation-test.sh too large to diff
test/projection-supply-mutation-test.sh too large to diff
test/replay-mutation-test.sh too large to diff
test/router-mutation-test.sh too large to diff
test/source-anchor-mutation-test.sh too large to diff
test/structural-mutation-test.sh too large to diff
test/workflow-mutation-test.sh too large to diff

CHANGELOG.md view

@@ -6,6 +6,42 @@  ## Unreleased +## 0.15.0.0 — 2026-08-30++### Breaking Changes++- Package-authored product records now use concise repeated labels under+  `DuplicateRecordFields`, `NoFieldSelectors`, and `OverloadedRecordDot`. Their+  generated selector functions and owner-prefixed field labels are removed from the+  public Haskell API; construction and constructor-directed matching remain supported.+  Migrate reads to record dot using the exhaustive+  [`record-field-migration-0.15.md`](src/record-field-migration-0.15.md) table. The twelve+  intentional single-field newtype unwrappers listed there remain explicit functions.+- Scaffolded Haskell advances from `idiomatic-v1` to `idiomatic-v2`. Generated product+  selectors are removed or renamed to concise labels, and the Cabal fragment now+  defaults `DuplicateRecordFields`, `NoFieldSelectors`, `OverloadedRecordDot`, and+  `OverloadedStrings`. Every existing pre-v2 ledger, including a historical ledger with+  no edition row, requires an explicit `--apply-generated-haskell-edition` run with+  durable from-edition backups; a legacy tree that also needs sidecar or module-name+  migration requires both apply flags in one run. Ordinary scaffolding refuses before+  writes. See the+  [adoption guide](https://github.com/shinzui/keiro/blob/master/docs/guides/adopting-keiro-dsl-idiomatic-v2.md).++### Other Changes++- Scaffold now refuses before writes when a ledger file exists but cannot be parsed,+  instead of treating corrupt history as absent.+- Generated-edition remediation reports attribute prefix, qualified, renamed+  record-dot, record-field, and operator-operand uses in recorded Hole files, while+  stating that compile errors remain authoritative outside that lexical inventory.+- `remediation-report.txt` is regenerated on every edition apply and no longer blocks a+  rollback, Hole edit, and retry; immutable edition backups remain the conflict evidence.+- JSON and wire keys, canonical/rendered output, diagnostics, fingerprints, `.keiro`+  language behavior, and runtime semantics are unchanged by the record migration.+- The checked package and generated-edition inventories, extension-policy gate, and+  Fourmolu parser options now enforce the record model and reject `FieldSelectors`+  escape hatches.+ ## 0.14.0.0 — 2026-08-21  ### Breaking Changes

app/Main.hs view

@@ -1,6 +1,5 @@--- | The @keiro-dsl@ command-line tool. EP-1 ships the @parse@ and @check@--- subcommands; a later milestone adds @scaffold@ to the same--- optparse-applicative command tree.+-- | The @keiro-dsl@ command-line tool, including parsing, checking, diffing,+-- scaffolding, and explicit generated-Haskell edition migration. module Main (main) where  import Control.Monad (when)@@ -30,14 +29,14 @@ import Keiro.Dsl.ReplayImpact (renderReplayImpact, replayImpactServices) import Keiro.Dsl.RuntimePackage (RuntimePackageName, mkRuntimePackageName) import Keiro.Dsl.Scaffold (Context (..), ScaffoldModule (..), codecComparisonBanner, codecComparisonModule)-import Keiro.Dsl.ScaffoldRun (checkIndexedServiceDiagnostics, executeServiceScaffoldWithRuntimePackageAndNameMigrations, planIndexedServiceScaffoldWithRuntimePackageAndGoldens, renderRefusals, renderScaffoldReport)-import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedSource, checkedSpec, effectiveContractLanguageVersion, languageContractNotice)+import Keiro.Dsl.ScaffoldRun (checkIndexedServiceDiagnostics, executeServiceScaffoldWithRuntimePackageAndMigrations, planIndexedServiceScaffoldWithRuntimePackageAndGoldens, renderRefusals, renderScaffoldReport)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSource, checkedSpec, languageContractNotice) import Keiro.Dsl.Skeleton (skeletonFor) import Keiro.Dsl.SourceIndex (ParsedSourceDocument (..), SemanticSourceIndex, emptySemanticSourceIndex) import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), DiagnosticOrigin (..), Severity (..), diagnosticCodeText, diagnosticOrigin, minimumLanguageDiagnostics, parseDiagnosticCode, renderDiagnostic, validateService) import Keiro.Dsl.Workspace (ContentSource (..), LineMap (..), OwnershipIndex (..), WorkspaceDiagnostic (..), WorkspaceFailure (..), WorkspaceFile (..), WorkspaceLocation (..), WorkspaceManifest (..), WorkspaceMember (..), WorkspaceMemberRef (..), WorkspaceSpec (..), checkWorkspace, checkWorkspaceForService, checkedWorkspace, fileContentSource, isWorkspacePath, loadWorkspace, nodeOwner, parseWorkspaceManifest, renderWorkspaceDiagnostic, renderWorkspaceFailure, renderWorkspaceManifest) import Keiro.Dsl.WorkspaceDiff (WorkspaceChange (..), WorkspaceMeta (..), diffWorkspaces, renderWorkspaceFinding, workspaceDiffReportWithImpacts)-import Keiro.Dsl.WorkspaceScaffold (executeWorkspaceScaffoldWithNameMigrations, planWorkspaceScaffoldWithRuntimePackageAndGoldens, renderWorkspaceScaffoldReport)+import Keiro.Dsl.WorkspaceScaffold (executeWorkspaceScaffoldWithMigrations, planWorkspaceScaffoldWithRuntimePackageAndGoldens, renderWorkspaceScaffoldReport) import Numeric.Natural (Natural) import Options.Applicative import System.Directory (canonicalizePath, createDirectoryIfMissing, doesFileExist)@@ -53,7 +52,7 @@   | Check FilePath CheckOptions   | Inspect FilePath InspectionFormat   | BehaviorObligations FilePath BehaviorFormat-  | Scaffold FilePath FilePath (Maybe String) (Maybe RuntimePackageName) Bool Bool Bool (Maybe FilePath) (Maybe (String, FilePath))+  | Scaffold FilePath FilePath (Maybe String) (Maybe RuntimePackageName) Bool Bool Bool Bool (Maybe FilePath) (Maybe (String, FilePath))   | Diff FilePath String (Maybe FilePath) (Maybe FilePath) [CompatibilitySurface] Bool (Maybe FilePath) (Maybe DiffCoverageOptions)   | New String @@ -109,7 +108,7 @@           (info (BehaviorObligations <$> fileArg <*> behaviorFormatOpt <**> helper) (progDesc "List static aggregate behavior obligations for a .keiro file or workspace"))         <> command           "scaffold"-          (info (Scaffold <$> fileArg <*> outOpt <*> optional moduleRootOpt <*> optional runtimePackageOpt <*> collocateSwitch <*> forceGeneratedOverwriteSwitch <*> applyNameMigrationsSwitch <*> optional goldensOpt <*> codecComparisonOpts <**> helper) (progDesc "Emit the generated layer + typed holes from a .keiro file"))+          (info (Scaffold <$> fileArg <*> outOpt <*> optional moduleRootOpt <*> optional runtimePackageOpt <*> collocateSwitch <*> forceGeneratedOverwriteSwitch <*> applyNameMigrationsSwitch <*> applyGeneratedHaskellEditionSwitch <*> optional goldensOpt <*> codecComparisonOpts <**> helper) (progDesc "Emit the generated layer + typed holes from a .keiro file"))         <> command           "diff"           (info (Diff <$> fileArg <*> sinceOpt <*> optional emitGoldensOpt <*> optional replayImpactOutOpt <*> many gateOpt <*> explainSwitch <*> optional reportOutOpt <*> diffCoverageOptions <**> helper) (progDesc "Classify spec changes since a git ref as per-surface compatibility vectors; exit non-zero on any gated BREAKING surface"))@@ -142,6 +141,9 @@ applyNameMigrationsSwitch :: Parser Bool applyNameMigrationsSwitch = switch (long "apply-name-migrations" <> help "Apply reviewed generated-Haskell source and sidecar moves with recoverable backups") +applyGeneratedHaskellEditionSwitch :: Parser Bool+applyGeneratedHaskellEditionSwitch = switch (long "apply-generated-haskell-edition" <> help "Adopt idiomatic-v2 generated Haskell with durable idiomatic-v1 backups and a Hole remediation report")+ goldensOpt :: Parser FilePath goldensOpt = strOption (long "goldens" <> metavar "DIR" <> help "Golden-payload root to embed in generated aggregate harnesses") @@ -265,15 +267,15 @@ -- immediate error, and this one could only ever be a silent no-op. validateCheckDenyCodes :: CheckOptions -> IO () validateCheckDenyCodes options = do-  when (CoverageOpaqueGateExceeded `elem` checkDenyCodes options) $ do+  when (CoverageOpaqueGateExceeded `elem` (.checkDenyCodes) options) $ do     TIO.hPutStrLn       stderr       "check: --deny CoverageOpaqueGateExceeded can never match; the code is the error --fail-on-opaque itself raises, so pass --fail-on-opaque instead of denying it"     exitFailure-  case [diagnosticCode | diagnosticCode <- checkDenyCodes options, diagnosticOrigin diagnosticCode == CoverageDiagnostic, diagnosticCode /= CoverageOpaqueGateExceeded] of+  case [diagnosticCode | diagnosticCode <- (.checkDenyCodes) options, diagnosticOrigin diagnosticCode == CoverageDiagnostic, diagnosticCode /= CoverageOpaqueGateExceeded] of     [] -> pure ()     unreachable-      | Just _ <- checkCoverage options -> pure ()+      | Just _ <- (.checkCoverage) options -> pure ()       | otherwise -> do           TIO.hPutStrLn             stderr@@ -346,29 +348,29 @@     <> T.pack (show legacyCount)     <> " legacy-unversioned member(s)"   where-    legacyCount = length [() | member <- wsMembers workspace, LegacyUnversioned <- [wmSourceLanguage member]]+    legacyCount = length [() | member <- (.members) workspace, LegacyUnversioned <- [(.sourceLanguage) member]]  minimumWorkspaceLanguageDiagnostics :: LanguageVersion -> WorkspaceSpec -> [WorkspaceDiagnostic] minimumWorkspaceLanguageDiagnostics floorVersion workspace   | effectiveVersion >= floorVersion = []   | otherwise =       [ WorkspaceDiagnostic-          { wdLocations =+          { locations =               NE.fromList                 ( WorkspaceLocation WorkspaceManifestFile 1 ""                     : [ WorkspaceLocation-                          (WorkspaceMemberFile (wmPath member))-                          (sourceLanguageLine (wmSourceLanguage member))+                          (WorkspaceMemberFile ((.path) member))+                          (sourceLanguageLine ((.sourceLanguage) member))                           ( "member selects effective language version "-                              <> languageVersionText (effectiveLanguageVersion (wmSourceLanguage member))+                              <> languageVersionText (effectiveLanguageVersion ((.sourceLanguage) member))                           )-                      | member <- wsMembers workspace+                      | member <- (.members) workspace                       ]                 ),-            wdSeverity = Error,-            wdCode = LanguageVersionBelowMinimum,-            wdSourceLanguageCause = Nothing,-            wdMessage =+            severity = Error,+            code = LanguageVersionBelowMinimum,+            sourceLanguageCause = Nothing,+            message =               "effective language version "                 <> languageVersionText effectiveVersion                 <> " (workspace-composed) is below the required minimum "@@ -379,28 +381,28 @@           }       ]   where-    effectiveVersion = effectiveContractLanguageVersion (checkedLanguageContract (checkedWorkspace workspace))+    effectiveVersion = (.contractLanguageVersion) (checkedLanguageContract (checkedWorkspace workspace))     sourceLanguageLine LegacyUnversioned = 1     sourceLanguageLine DeclaredLanguage {languageVersionLoc = Loc lineNumber} = lineNumber  deniesWarningCode :: CheckOptions -> DiagnosticCode -> Bool deniesWarningCode options diagnosticCode =-  checkDenyWarnings options || diagnosticCode `elem` checkDenyCodes options+  (.checkDenyWarnings) options || diagnosticCode `elem` (.checkDenyCodes) options  deniedSourceWarningCodes :: CheckOptions -> [Diagnostic] -> [DiagnosticCode] deniedSourceWarningCodes options diagnostics =-  [ code diagnostic+  [ (.code) diagnostic   | diagnostic <- diagnostics,-    severity diagnostic == Warning,-    deniesWarningCode options (code diagnostic)+    (.severity) diagnostic == Warning,+    deniesWarningCode options ((.code) diagnostic)   ]  deniedWorkspaceWarningCodes :: CheckOptions -> [WorkspaceDiagnostic] -> [DiagnosticCode] deniedWorkspaceWarningCodes options diagnostics =-  [ wdCode diagnostic+  [ (.code) diagnostic   | diagnostic <- diagnostics,-    wdSeverity diagnostic == Warning,-    deniesWarningCode options (wdCode diagnostic)+    (.severity) diagnostic == Warning,+    deniesWarningCode options ((.code) diagnostic)   ]  emitDeniedWarningSummary :: [DiagnosticCode] -> IO ()@@ -416,9 +418,9 @@ checkReportEnforcement :: CheckOptions -> CheckReport.CheckReportEnforcement checkReportEnforcement options =   CheckReport.CheckReportEnforcement-    { CheckReport.reportMinLanguage = checkMinLanguage options,-      CheckReport.reportDenyWarnings = checkDenyWarnings options,-      CheckReport.reportDenyCodes = checkDenyCodes options+    { CheckReport.minLanguage = (.checkMinLanguage) options,+      CheckReport.denyWarnings = (.checkDenyWarnings) options,+      CheckReport.denyCodes = (.checkDenyCodes) options     }  -- | Write a check report to @--report-out@, creating any missing parent@@ -431,7 +433,7 @@         createDirectoryIfMissing True (takeDirectory path)         Aeson.encodeFile path report     )-    (checkReportOut options)+    ((.checkReportOut) options)  writeSourceCheckReport :: FilePath -> ParsedSource -> CheckedService -> CheckOptions -> [Diagnostic] -> IO () writeSourceCheckReport subject parsedSource service options diagnostics =@@ -439,7 +441,7 @@     options     ( CheckReport.checkReport         subject-        (parsedSourceLanguage parsedSource)+        ((.sourceLanguage) parsedSource)         (checkedLanguageContract service)         enforcement         diagnostics@@ -494,8 +496,8 @@   | isWorkspacePath fp = runWorkspaceInspect fp format run (BehaviorObligations fp format)   | isWorkspacePath fp = runWorkspaceBehaviorObligations fp format-run (Scaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations cliGoldens comparisonRequest)-  | isWorkspacePath fp = runWorkspaceScaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations cliGoldens comparisonRequest+run (Scaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition cliGoldens comparisonRequest)+  | isWorkspacePath fp = runWorkspaceScaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition cliGoldens comparisonRequest run (Diff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions)   | isWorkspacePath fp = runWorkspaceDiff fp ref emitGoldensRoot replayImpactOut gatedSurfaces explain reportOut coverageOptions run (Parse fp) = do@@ -504,27 +506,27 @@     Left failure -> do       hPutStrLn stderr (T.unpack (renderParseFailure failure))       exitFailure-    Right ParsedSourceDocument {documentParsedSource = parsedSource} -> TIO.putStrLn (renderSource parsedSource)+    Right ParsedSourceDocument {parsedSource = parsedSource} -> TIO.putStrLn (renderSource parsedSource) run (Check fp options) = do   input <- TIO.readFile fp   case parseSourceDocument fp input of     Left failure -> do       hPutStrLn stderr (T.unpack (renderParseFailure failure))       exitFailure-    Right ParsedSourceDocument {documentParsedSource = parsedSource, documentSourceIndex = sourceIndex} -> do+    Right ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} -> do       validateCheckDenyCodes options       let service = checkedSource parsedSource           spec = checkedSpec service-          floorDiags = maybe [] (\floorVersion -> minimumLanguageDiagnostics floorVersion (parsedSourceLanguage parsedSource)) (checkMinLanguage options)+          floorDiags = maybe [] (\floorVersion -> minimumLanguageDiagnostics floorVersion ((.sourceLanguage) parsedSource)) ((.checkMinLanguage) options)           semanticDiags = floorDiags <> checkIndexedServiceDiagnostics Nothing sourceIndex (mkContext Nothing False spec) service-          semanticFailed = any ((== Error) . severity) semanticDiags-      emitLanguageContractNotice fp (sourceFormText (parsedSourceLanguage parsedSource)) service+          semanticFailed = any ((== Error) . (.severity)) semanticDiags+      emitLanguageContractNotice fp (sourceFormText ((.sourceLanguage) parsedSource)) service       mapM_ (TIO.hPutStrLn stderr . renderDiagnostic fp) semanticDiags       -- Coverage is part of this invocation's diagnostic surface, not a       -- success-path artifact: its findings must reach the deny policy, the exit       -- code, and the check report. It still runs only after semantic validation       -- passes, because an unresolvable graph has nothing to cover.-      coveragePlan <- planCheckCoverage fp service (if semanticFailed then Nothing else checkCoverage options)+      coveragePlan <- planCheckCoverage fp service (if semanticFailed then Nothing else (.checkCoverage) options)       coverageOk <- emitPlannedCoverage coveragePlan       let diags = semanticDiags <> plannedCoverageDiagnostics coveragePlan           deniedWarningCodes = deniedSourceWarningCodes options diags@@ -533,30 +535,30 @@       if semanticFailed || not coverageOk || not (null deniedWarningCodes)         then exitFailure         else do-          when (checkEmit options) (TIO.putStrLn (renderSource parsedSource))-          if checkExplainBindings options+          when ((.checkEmit) options) (TIO.putStrLn (renderSource parsedSource))+          if (.checkExplainBindings) options             then case bindingObligationsForService service of               Left graphErrors -> do                 hPutStrLn stderr ("validated spec did not resolve its mapped type graph: " <> show graphErrors)                 exitFailure-              Right obligations -> TIO.putStrLn (renderBindingObligations (specContext spec) obligations)+              Right obligations -> TIO.putStrLn (renderBindingObligations ((.context) spec) obligations)             else pure ()-          when (not (checkEmit options) && not (checkExplainBindings options)) (putStrLn "OK")-run (Scaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations cliGoldens comparisonRequest) = do+          when (not ((.checkEmit) options) && not ((.checkExplainBindings) options)) (putStrLn "OK")+run (Scaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition cliGoldens comparisonRequest) = do   input <- TIO.readFile fp   case parseSourceDocument fp input of     Left failure -> do       hPutStrLn stderr (T.unpack (renderParseFailure failure))       exitFailure-    Right ParsedSourceDocument {documentParsedSource = parsedSource, documentSourceIndex = sourceIndex} -> do+    Right ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} -> do       let service = checkedSource parsedSource           spec = checkedSpec service-      emitLanguageContractNotice fp (sourceFormText (parsedSourceLanguage parsedSource)) service+      emitLanguageContractNotice fp (sourceFormText ((.sourceLanguage) parsedSource)) service       -- Validation gate: never scaffold an invalid spec. Abort on any       -- error-severity diagnostic before writing a single module.       let diags = validateService service       mapM_ (TIO.hPutStrLn stderr . renderDiagnostic fp) diags-      when (any ((== Error) . severity) diags) exitFailure+      when (any ((== Error) . (.severity)) diags) exitFailure       let ctx = mkContext cliRoot cliCollocate spec           goldenRoot = fromMaybe (takeDirectory fp </> "golden-payloads") cliGoldens       goldens <- loadGoldenPayloads goldenRoot spec@@ -570,7 +572,7 @@           case comparisonReady of             Left comparisonError -> TIO.hPutStrLn stderr comparisonError >> exitFailure             Right () -> do-              result <- executeServiceScaffoldWithRuntimePackageAndNameMigrations cliRuntimePackage applyNameMigrations out forceGeneratedOverwrite fp (parsedSourceLanguage parsedSource) ctx service modules+              result <- executeServiceScaffoldWithRuntimePackageAndMigrations cliRuntimePackage applyNameMigrations applyGeneratedHaskellEdition out forceGeneratedOverwrite fp ((.sourceLanguage) parsedSource) ctx service modules               case result of                 Left refusals -> do                   mapM_ (TIO.hPutStrLn stderr) (renderRefusals refusals)@@ -586,19 +588,19 @@   input <- TIO.readFile fp   case parseSourceDocument fp input of     Left failure -> hPutStrLn stderr (T.unpack (renderParseFailure failure)) >> exitFailure-    Right ParsedSourceDocument {documentParsedSource = parsedSource} ->+    Right ParsedSourceDocument {parsedSource = parsedSource} ->       TLIO.putStrLn-        (AesonText.encodeToLazyText (sourceInspection fp (parsedSourceLanguage parsedSource) (checkedSource parsedSource)))+        (AesonText.encodeToLazyText (sourceInspection fp ((.sourceLanguage) parsedSource) (checkedSource parsedSource))) run (BehaviorObligations fp format) = do   input <- TIO.readFile fp   case parseSourceDocument fp input of     Left failure -> hPutStrLn stderr (T.unpack (renderParseFailure failure)) >> exitFailure-    Right ParsedSourceDocument {documentParsedSource = parsedSource, documentSourceIndex = sourceIndex} -> do+    Right ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} -> do       let service = checkedSource parsedSource           spec = checkedSpec service           diagnostics = validateService service       mapM_ (TIO.hPutStrLn stderr . renderDiagnostic fp) diagnostics-      if any ((== Error) . severity) diagnostics+      if any ((== Error) . (.severity)) diagnostics         then exitFailure         else case sourceAwareBehaviorReport fp Nothing sourceIndex spec of           Left failure -> renderBehaviorReportFailure failure@@ -621,14 +623,14 @@           case (,) <$> parseSourceDocument (ref <> ":" <> relPath) (T.pack oldText) <*> parseSourceDocument fp newText of             Left failure -> hPutStrLn stderr (T.unpack (renderParseFailure failure)) >> exitFailure             Right-              ( ParsedSourceDocument {documentParsedSource = oldSource},-                ParsedSourceDocument {documentParsedSource = newSource}+              ( ParsedSourceDocument {parsedSource = oldSource},+                ParsedSourceDocument {parsedSource = newSource}                 ) -> do                 let oldService = checkedSource oldSource                     newService = checkedSource newSource                     oldSpec = checkedSpec oldService                     newSpec = checkedSpec newService-                emitLanguageContractNotice fp (sourceFormText (parsedSourceLanguage newSource)) newService+                emitLanguageContractNotice fp (sourceFormText ((.sourceLanguage) newSource)) newService                 case (,) <$> diffSources oldSource newSource <*> replayImpactServices oldService newService of                   Left surfaceError -> TIO.hPutStrLn stderr (renderFoldSurfaceError surfaceError) >> exitFailure                   Right (changes, impact) -> do@@ -646,7 +648,7 @@                     mapM_ (`Aeson.encodeFile` impact) replayImpactOut                     mapM_ (\path -> Aeson.encodeFile path (diffReportWithImpacts effectiveGate changes semanticImpact coordination)) reportOut                     coverageOk <- runDiffCoverage fp (T.pack ref) oldSpec newSpec coverageOptions-                    if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . coordinationSeverity) coordination || not coverageOk then exitFailure else pure ()+                    if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . (.severity)) coordination || not coverageOk then exitFailure else pure ()  -- | @parse@ on a workspace manifest: read it, parse it, and print it back in -- canonical form (clauses in order, members codepoint-sorted).@@ -685,22 +687,22 @@                 [ "schema" .= ("keiro-dsl/source-inspection/1" :: T.Text),                   "kind" .= ("workspace" :: T.Text),                   "path" .= fp,-                  "service" .= wsService workspace,+                  "service" .= (.service) workspace,                   "effectiveSemanticContract" .= checkedLanguageContract (checkedWorkspace workspace),-                  "members" .= map memberInspection (wsMembers workspace)+                  "members" .= map memberInspection ((.members) workspace)                 ]             )         )   where     memberInspection member =       Aeson.object-        [ "path" .= wmPath member,+        [ "path" .= (.path) member,           "sourceForm" .= sourceFormText sourceLanguage,           "declaredLanguageVersion" .= declaredLanguageVersionMaybe sourceLanguage,           "effectiveLanguageVersion" .= effectiveLanguageVersion sourceLanguage         ]       where-        sourceLanguage = wmSourceLanguage member+        sourceLanguage = (.sourceLanguage) member  runWorkspaceBehaviorObligations :: FilePath -> BehaviorFormat -> IO () runWorkspaceBehaviorObligations fp format = do@@ -710,7 +712,7 @@     Right workspace -> do       let diagnostics = checkWorkspace workspace       mapM_ (TIO.hPutStrLn stderr . renderWorkspaceDiagnostic fp) diagnostics-      if any ((== Error) . wdSeverity) diagnostics+      if any ((== Error) . (.severity)) diagnostics         then exitFailure         else case workspaceBehaviorReport workspace of           Left failure -> renderBehaviorReportFailure failure@@ -719,17 +721,19 @@ workspaceBehaviorReport :: WorkspaceSpec -> Either BehaviorReportFailure Behavior.BehaviorObligationsReport workspaceBehaviorReport workspace =   sourceAwareBehaviorReport-    (wsManifestPath workspace)-    (Just (wsService workspace))-    (wsSourceIndex workspace)+    ((.manifestPath) workspace)+    (Just ((.service) workspace))+    ((.sourceIndex) workspace)     (checkedSpec (checkedWorkspace workspace))     >>= \report ->       pure-        report-          { Behavior.behaviorRequirements =+        Behavior.BehaviorObligationsReport+          { Behavior.subject = report.subject,+            Behavior.workspaceService = report.workspaceService,+            Behavior.requirements =               map-                (Behavior.attributeBehaviorOwner (fmap fst . nodeOwner (wsOwnership workspace) "aggregate"))-                (Behavior.behaviorRequirements report)+                (Behavior.attributeBehaviorOwner (fmap fst . nodeOwner workspace.ownership "aggregate"))+                report.requirements           }  data BehaviorReportFailure@@ -742,9 +746,9 @@   sourceEntries <- either (Left . BehaviorReportSourceFailed) Right (BehaviorSource.planBehaviorSourceMap requirements sourceIndex)   pure     Behavior.BehaviorObligationsReport-      { Behavior.behaviorSubject = subject,-        Behavior.behaviorWorkspaceService = workspaceService,-        Behavior.behaviorRequirements = BehaviorSource.attachBehaviorSourceLocations sourceEntries requirements+      { Behavior.subject = subject,+        Behavior.workspaceService = workspaceService,+        Behavior.requirements = BehaviorSource.attachBehaviorSourceLocations sourceEntries requirements       }  writeBehaviorReport :: BehaviorFormat -> Behavior.BehaviorObligationsReport -> IO ()@@ -765,11 +769,11 @@       ( \sourceFailure ->           hPutStrLn             stderr-            ( show (BehaviorSource.failureCode sourceFailure)+            ( show ((.code) sourceFailure)                 <> " "-                <> T.unpack (Behavior.unBehaviorKey (BehaviorSource.failureKey sourceFailure))+                <> T.unpack (Behavior.unBehaviorKey ((.key) sourceFailure))                 <> ": "-                <> T.unpack (BehaviorSource.failureMessage sourceFailure)+                <> T.unpack ((.message) sourceFailure)             )       )       errors@@ -795,15 +799,15 @@       exitFailure     Right workspace -> do       let service = checkedWorkspace workspace-          floorDiags = maybe [] (\floorVersion -> minimumWorkspaceLanguageDiagnostics floorVersion workspace) (checkMinLanguage options)+          floorDiags = maybe [] (\floorVersion -> minimumWorkspaceLanguageDiagnostics floorVersion workspace) ((.checkMinLanguage) options)           semanticDiags = floorDiags <> checkWorkspaceForService workspace service           spec = checkedSpec service-          semanticFailed = any ((== Error) . wdSeverity) semanticDiags+          semanticFailed = any ((== Error) . (.severity)) semanticDiags       emitWorkspaceLanguageContractNotice fp workspace       mapM_ (TIO.hPutStrLn stderr . renderWorkspaceDiagnostic fp) semanticDiags       -- Same contract as the single-spec path: coverage findings are gated       -- diagnostics, not success-path output. See `run (Check …)` above.-      coveragePlan <- planCheckCoverage fp service (if semanticFailed then Nothing else checkCoverage options)+      coveragePlan <- planCheckCoverage fp service (if semanticFailed then Nothing else (.checkCoverage) options)       coverageOk <- emitPlannedCoverage coveragePlan       let diags = semanticDiags <> map (workspaceCoverageDiagnostic fp) (plannedCoverageFindings coveragePlan)           deniedWarningCodes = deniedWorkspaceWarningCodes options diags@@ -812,15 +816,15 @@       if semanticFailed || not coverageOk || not (null deniedWarningCodes)         then exitFailure         else do-          when (checkEmit options) (TIO.putStrLn (renderSpec spec))-          if checkExplainBindings options+          when ((.checkEmit) options) (TIO.putStrLn (renderSpec spec))+          if (.checkExplainBindings) options             then case bindingObligationsForService service of               Left graphErrors -> do                 hPutStrLn stderr ("validated workspace did not resolve its mapped type graph: " <> show graphErrors)                 exitFailure-              Right obligations -> TIO.putStrLn (renderBindingObligations (wsContext workspace) obligations)+              Right obligations -> TIO.putStrLn (renderBindingObligations ((.context) workspace) obligations)             else pure ()-          when (not (checkEmit options) && not (checkExplainBindings options)) (putStrLn "OK")+          when (not ((.checkEmit) options) && not ((.checkExplainBindings) options)) (putStrLn "OK")  -- | @scaffold@ on a workspace manifest: compose the whole service, then plan -- and emit the complete module set for every member in one invocation.@@ -842,10 +846,11 @@   Bool ->   Bool ->   Bool ->+  Bool ->   Maybe FilePath ->   Maybe (String, FilePath) ->   IO ()-runWorkspaceScaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations cliGoldens comparisonRequest = do+runWorkspaceScaffold fp out cliRoot cliRuntimePackage cliCollocate forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition cliGoldens comparisonRequest = do   loaded <- loadWorkspace (fileContentSource (takeDirectory fp)) fp   case loaded of     Left failure -> do@@ -857,12 +862,12 @@       -- error-severity diagnostic before writing a single module.       let diags = checkWorkspace workspace       mapM_ (TIO.hPutStrLn stderr . renderWorkspaceDiagnostic fp) diags-      when (any ((== Error) . wdSeverity) diags) exitFailure+      when (any ((== Error) . (.severity)) diags) exitFailure       let spec = checkedSpec (checkedWorkspace workspace)           ctx = workspaceContext cliRoot cliCollocate workspace           effectiveRuntimePackage = case cliRuntimePackage of             Just packageName -> Just packageName-            Nothing -> wsRuntimePackage workspace+            Nothing -> (.runtimePackage) workspace           goldenRoot = fromMaybe (takeDirectory fp </> "golden-payloads") cliGoldens       goldens <- loadGoldenPayloads goldenRoot spec       case ( planWorkspaceScaffoldWithRuntimePackageAndGoldens goldens effectiveRuntimePackage goldenRoot ctx workspace,@@ -877,7 +882,7 @@           case comparisonReady of             Left comparisonError -> TIO.hPutStrLn stderr comparisonError >> exitFailure             Right () -> do-              result <- executeWorkspaceScaffoldWithNameMigrations out forceGeneratedOverwrite applyNameMigrations plan+              result <- executeWorkspaceScaffoldWithMigrations out forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition plan               case result of                 Left refusals -> do                   mapM_ (TIO.hPutStrLn stderr) (renderRefusals refusals)@@ -963,18 +968,18 @@                         Right (workspaceChanges, impact) -> do                           written <- maybe (pure []) (\root -> emitGoldenPayloads root oldSpec newSpec) goldenRoot                           mapM_ (putStrLn . ("golden: wrote synthesized weak stand-in " <>)) written-                          let changes = map wcChange workspaceChanges+                          let changes = map (.change) workspaceChanges                               effectiveGate = gateWith gatedSurfaces                               semanticImpact = CheckedDiff.mappedSemanticImpactForServices oldService newService                               coordination = coordinationImpact oldService newService semanticImpact                               reportMeta =                                 WorkspaceMeta-                                  { wmIdentity = wsService newWorkspace,-                                    wmManifest = fp,-                                    wmSince = T.pack ref,-                                    wmMembersOld = map wmPath (wsMembers oldWorkspace),-                                    wmMembersNew = map wmPath (wsMembers newWorkspace),-                                    wmAdoptionBaseline = adoptionBaseline+                                  { identity = (.service) newWorkspace,+                                    manifest = fp,+                                    since = T.pack ref,+                                    membersOld = map (.path) ((.members) oldWorkspace),+                                    membersNew = map (.path) ((.members) newWorkspace),+                                    adoptionBaseline = adoptionBaseline                                   }                           mapM_ (TIO.putStrLn . renderWorkspaceFinding) workspaceChanges                           mapM_ TIO.putStrLn (renderSemanticImpact semanticImpact)@@ -985,7 +990,7 @@                           mapM_ (`Aeson.encodeFile` impact) replayImpactOut                           mapM_ (\path -> Aeson.encodeFile path (workspaceDiffReportWithImpacts reportMeta effectiveGate workspaceChanges semanticImpact coordination)) reportOut                           coverageOk <- runDiffCoverage fp (T.pack ref) oldSpec newSpec coverageOptions-                          if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . coordinationSeverity) coordination || not coverageOk then exitFailure else pure ()+                          if any (gatedBreaking effectiveGate) changes || any ((== CoordinationBreaking) . (.severity)) coordination || not coverageOk then exitFailure else pure ()  -- | A @git show@ backed source rooted at a workspace manifest directory. gitContentSource :: FilePath -> String -> FilePath -> ContentSource@@ -1010,41 +1015,63 @@   WorkspaceSpec ->   IO (Either WorkspaceFailure WorkspaceSpec) loadAdoptionBaseline oldSource manifestPath currentManifest newWorkspace = do-  present <- traverse presentAtRevision (NE.toList (wmfMembers currentManifest))+  present <- traverse presentAtRevision (NE.toList ((.members) currentManifest))   case NE.nonEmpty [member | (member, True) <- present] of     Nothing -> pure (Right (emptyWorkspaceBaseline newWorkspace))     Just members ->-      let oldManifest = currentManifest {wmfMembers = members}+      let oldManifest =+            WorkspaceManifest+              { service = (.service) currentManifest,+                serviceLoc = (.serviceLoc) currentManifest,+                runtimePackage = (.runtimePackage) currentManifest,+                runtimePackageLoc = (.runtimePackageLoc) currentManifest,+                moduleRoot = (.moduleRoot) currentManifest,+                moduleRootLoc = (.moduleRootLoc) currentManifest,+                layout = (.layout) currentManifest,+                layoutLoc = (.layoutLoc) currentManifest,+                members = members+              }           manifestName = takeFileName manifestPath           baselineSource =             ContentSource               { csRead = \relative ->                   if relative == manifestName                     then pure (Right (renderWorkspaceManifest oldManifest))-                    else csRead oldSource relative+                    else (.csRead) oldSource relative               }        in loadWorkspace baselineSource manifestPath   where     presentAtRevision member = do-      result <- csRead oldSource (wmrPath member)+      result <- (.csRead) oldSource ((.path) member)       pure (member, either (const False) (const True) result)  -- | The sound old side when every current member is new at the adoption ref. emptyWorkspaceBaseline :: WorkspaceSpec -> WorkspaceSpec emptyWorkspaceBaseline workspace =-  workspace-    { wsMembers = [],-      wsMergedSpec =-        (wsMergedSpec workspace)-          { specIds = [],-            specEnums = [],-            specRules = [],-            specMapped = [],-            specNodes = []+  WorkspaceSpec+    { service = workspace.service,+      manifestPath = workspace.manifestPath,+      languageContract = workspace.languageContract,+      context = workspace.context,+      runtimePackage = workspace.runtimePackage,+      moduleRoot = workspace.moduleRoot,+      layout = workspace.layout,+      members = [],+      mergedSpec =+        Spec+          { context = workspace.mergedSpec.context,+            moduleRoot = workspace.mergedSpec.moduleRoot,+            layout = workspace.mergedSpec.layout,+            ids = [],+            enums = [],+            rules = [],+            nominalScalars = workspace.mergedSpec.nominalScalars,+            mapped = [],+            nodes = []           },-      wsSourceIndex = emptySemanticSourceIndex,-      wsLineMap = LineMap [],-      wsOwnership = OwnershipIndex mempty mempty+      sourceIndex = emptySemanticSourceIndex,+      lineMap = LineMap [],+      ownership = OwnershipIndex mempty mempty     }  workspaceGoldenRoot :: FilePath -> FilePath -> FilePath@@ -1066,12 +1093,12 @@ workspaceContext :: Maybe String -> Bool -> WorkspaceSpec -> Context workspaceContext cliRoot cliCollocate workspace =   Context-    { contextName = wsContext workspace,-      moduleRoot = maybe (fromMaybe "" (wsModuleRoot workspace)) T.pack cliRoot,+    { name = (.context) workspace,+      moduleRoot = maybe (fromMaybe "" ((.moduleRoot) workspace)) T.pack cliRoot,       placement =         if cliCollocate           then CollocatedLeaf-          else fromMaybe GeneratedPrefix (wsLayout workspace)+          else fromMaybe GeneratedPrefix ((.layout) workspace)     }  shouldExplain :: Change -> Bool@@ -1093,7 +1120,7 @@ preflightComparison :: FilePath -> Maybe (String, FilePath) -> Maybe ScaffoldModule -> IO (Either T.Text ()) preflightComparison _ Nothing Nothing = pure (Right ()) preflightComparison out (Just (_, requestedPath)) (Just comparisonModule) = do-  let expectedPath = normalise (out </> modulePath comparisonModule)+  let expectedPath = normalise (out </> (.path) comparisonModule)       actualPath = normalise requestedPath   if actualPath /= expectedPath     then@@ -1120,7 +1147,7 @@ writeComparison Nothing Nothing = pure () writeComparison (Just (_, path)) (Just comparisonModule) = do   createDirectoryIfMissing True (takeDirectory path)-  TIO.writeFile path (moduleText comparisonModule)+  TIO.writeFile path ((.text) comparisonModule)   TIO.hPutStrLn stderr ("comparison generated " <> T.pack path <> " (migration evidence only)") writeComparison _ _ = hPutStrLn stderr "internal error: incomplete codec-comparison output" >> exitFailure @@ -1141,11 +1168,11 @@     Left graphErrors -> CoverageUnresolved (show graphErrors)     Right baseReport ->       PlannedCoverage-        (checkCoveragePath options)-        (if checkFailOnOpaque options then Coverage.failOnOpaque baseReport else baseReport)+        ((.checkCoveragePath) options)+        (if (.checkFailOnOpaque) options then Coverage.failOnOpaque baseReport else baseReport)  plannedCoverageFindings :: PlannedCoverage -> [Coverage.CoverageFinding]-plannedCoverageFindings (PlannedCoverage _ report) = Coverage.coverageFindings report+plannedCoverageFindings (PlannedCoverage _ report) = (.findings) report plannedCoverageFindings _ = []  -- | Coverage findings as ordinary source diagnostics. They carry no line, which@@ -1154,8 +1181,8 @@ plannedCoverageDiagnostics plan =   [ Diagnostic       { line = 0,-        severity = Coverage.findingSeverity finding,-        code = Coverage.findingCode finding,+        severity = (.severity) finding,+        code = (.code) finding,         relatedLocations = [],         message = Coverage.coverageFindingMessage finding       }@@ -1167,11 +1194,11 @@ workspaceCoverageDiagnostic :: FilePath -> Coverage.CoverageFinding -> WorkspaceDiagnostic workspaceCoverageDiagnostic _ finding =   WorkspaceDiagnostic-    { wdLocations = NE.fromList [WorkspaceLocation WorkspaceManifestFile 0 ""],-      wdSeverity = Coverage.findingSeverity finding,-      wdCode = Coverage.findingCode finding,-      wdSourceLanguageCause = Nothing,-      wdMessage = Coverage.coverageFindingMessage finding+    { locations = NE.fromList [WorkspaceLocation WorkspaceManifestFile 0 ""],+      severity = (.severity) finding,+      code = (.code) finding,+      sourceLanguageCause = Nothing,+      message = Coverage.coverageFindingMessage finding     }  emitPlannedCoverage :: PlannedCoverage -> IO Bool@@ -1189,12 +1216,12 @@       hPutStrLn stderr ("diff specs did not resolve their mapped type graph for coverage: " <> show graphErrors)       pure False     Right baseReport -> do-      let report = if diffFailOnOpaqueIncrease options then Coverage.failOnOpaqueIncrease baseReport else baseReport-      emitCoverageReport (diffCoveragePath options) report+      let report = if (.diffFailOnOpaqueIncrease) options then Coverage.failOnOpaqueIncrease baseReport else baseReport+      emitCoverageReport ((.diffCoveragePath) options) report  emitCoverageReport :: FilePath -> Coverage.CoverageReport -> IO Bool emitCoverageReport path report = do-  mapM_ (TIO.hPutStrLn stderr . Coverage.renderCoverageFinding (Coverage.coverageSpec report)) (Coverage.coverageFindings report)+  mapM_ (TIO.hPutStrLn stderr . Coverage.renderCoverageFinding ((.spec) report)) ((.findings) report)   TIO.putStr (Coverage.renderCoverageSummary report)   Coverage.writeCoverageReport path report   putStrLn ("coverage report written to " <> path)@@ -1205,10 +1232,10 @@ mkContext :: Maybe String -> Bool -> Spec -> Context mkContext cliRoot cliCollocate spec =   Context-    { contextName = specContext spec,-      moduleRoot = maybe (fromMaybe "" (specModuleRoot spec)) T.pack cliRoot,+    { name = (.context) spec,+      moduleRoot = maybe (fromMaybe "" ((.moduleRoot) spec)) T.pack cliRoot,       placement =         if cliCollocate           then CollocatedLeaf-          else fromMaybe GeneratedPrefix (specLayout spec)+          else fromMaybe GeneratedPrefix ((.layout) spec)     }

bench/structural-codec/Main.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedRecordDot #-}- module Main (main) where  import Conformance.Structural.Bindings qualified as Bindings

+ generated-haskell-edition-idiomatic-v2.md view

file too large to diff

+ internal/Keiro/Dsl/GeneratedHaskellLanguage.hs view

@@ -0,0 +1,174 @@+-- | The Haskell language contract for overwriteable generated modules.+--+-- The manifest and conformance build profile publish the shared baseline.+-- Syntax outside that baseline must be requested through the closed extension+-- type and rendered as a module-local pragma.+module Keiro.Dsl.GeneratedHaskellLanguage+  ( GeneratedHaskellExtension (..),+    generatedHaskellDefaultLanguage,+    generatedHaskellDefaultExtensions,+    idiomaticV2LabelMigrations,+    modernizeGeneratedHaskellSource,+    modernizeGeneratedHaskellSourceWithState,+    RewriteState (..),+    renderGeneratedLanguagePragmas,+  )+where++import Data.Char (isAlphaNum)+import Data.List (nub, sort)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T++data GeneratedHaskellExtension+  = ExtBlockArguments+  | ExtDeriveAnyClass+  | ExtDuplicateRecordFields+  | ExtOverloadedLabels+  | ExtOverloadedRecordDot+  | ExtQualifiedDo+  | ExtTemplateHaskell+  | ExtTypeFamilies+  deriving (Eq, Ord, Show)++generatedHaskellDefaultLanguage :: Text+generatedHaskellDefaultLanguage = "GHC2024"++generatedHaskellDefaultExtensions :: [Text]+generatedHaskellDefaultExtensions =+  [ "DuplicateRecordFields",+    "NoFieldSelectors",+    "OverloadedRecordDot",+    "OverloadedStrings"+  ]++renderGeneratedLanguagePragmas :: [GeneratedHaskellExtension] -> [Text]+renderGeneratedLanguagePragmas =+  map renderPragma+    . filter (`notElem` generatedHaskellDefaultExtensions)+    . sort+    . nub+    . map extensionName+  where+    renderPragma name = "{-# LANGUAGE " <> name <> " #-}"++extensionName :: GeneratedHaskellExtension -> Text+extensionName extension = case extension of+  ExtBlockArguments -> "BlockArguments"+  ExtDeriveAnyClass -> "DeriveAnyClass"+  ExtDuplicateRecordFields -> "DuplicateRecordFields"+  ExtOverloadedLabels -> "OverloadedLabels"+  ExtOverloadedRecordDot -> "OverloadedRecordDot"+  ExtQualifiedDo -> "QualifiedDo"+  ExtTemplateHaskell -> "TemplateHaskell"+  ExtTypeFamilies -> "TypeFamilies"++-- | Apply the idiomatic-v2 product-label mapping to Haskell identifiers while+-- preserving comments and literals byte for byte. The emitter templates still+-- use the released idiomatic-v1 labels as their semantic vocabulary; keeping+-- the presentation rewrite here makes the edition boundary complete and keeps+-- wire strings, diagnostics, and generated comments outside that boundary.+modernizeGeneratedHaskellSource :: Text -> Text+modernizeGeneratedHaskellSource = fst . modernizeGeneratedHaskellSourceWithState++modernizeGeneratedHaskellSourceWithState :: Text -> (Text, RewriteState)+modernizeGeneratedHaskellSourceWithState source =+  let (output, finalState) = go Code (T.unpack source)+   in (T.pack output, finalState)+  where+    go Code [] = ([], Code)+    go LineComment [] = ([], Code)+    go state [] = ([], state)+    go Code input@('-' : '-' : _) =+      let (dashes, remaining) = span (== '-') input+          startsComment = case remaining of+            [] -> True+            character : _ -> not (isHaskellSymbol character)+       in emit dashes (go (if startsComment then LineComment else Code) remaining)+    go Code ('{' : '-' : rest) = emit "{-" (go (BlockComment 1) rest)+    go Code ('"' : rest) = emit "\"" (go StringLiteral rest)+    go Code ('\'' : rest)+      | startsCharacterLiteral rest = emit "'" (go CharacterLiteral rest)+      | otherwise = emit "'" (go Code rest)+    go Code sourceText@(character : rest)+      | identifierStart character =+          let (token, remaining) = span identifierCharacter sourceText+              replacement = Map.findWithDefault (T.pack token) (T.pack token) idiomaticV2Labels+           in emit (T.unpack replacement) (go Code remaining)+      | otherwise = emit [character] (go Code rest)+    go LineComment ('\n' : rest) = emit "\n" (go Code rest)+    go LineComment (character : rest) = emit [character] (go LineComment rest)+    go (BlockComment depth) ('{' : '-' : rest) = emit "{-" (go (BlockComment (depth + 1)) rest)+    go (BlockComment 1) ('-' : '}' : rest) = emit "-}" (go Code rest)+    go (BlockComment depth) ('-' : '}' : rest) = emit "-}" (go (BlockComment (depth - 1)) rest)+    go (BlockComment depth) (character : rest) = emit [character] (go (BlockComment depth) rest)+    go StringLiteral ('\\' : escaped : rest) = emit ['\\', escaped] (go StringLiteral rest)+    go StringLiteral ('"' : rest) = emit "\"" (go Code rest)+    go StringLiteral (character : rest) = emit [character] (go StringLiteral rest)+    go CharacterLiteral ('\\' : escaped : rest) = emit ['\\', escaped] (go CharacterLiteral rest)+    go CharacterLiteral ('\'' : rest) = emit "'" (go Code rest)+    go CharacterLiteral (character : rest) = emit [character] (go CharacterLiteral rest)++    emit prefix (output, state) = (prefix <> output, state)+    startsCharacterLiteral ('\\' : _) = True+    startsCharacterLiteral (_ : '\'' : _) = True+    startsCharacterLiteral _ = False+    isHaskellSymbol character = character `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)+    identifierStart character = character == '_' || character >= 'A' && character <= 'Z' || character >= 'a' && character <= 'z'+    identifierCharacter character = identifierStart character || isAlphaNum character || character == '\''++data RewriteState+  = Code+  | LineComment+  | BlockComment !Int+  | StringLiteral+  | CharacterLiteral+  deriving stock (Eq, Show)++idiomaticV2Labels :: Map.Map Text Text+idiomaticV2Labels = Map.fromList idiomaticV2LabelMigrations++idiomaticV2LabelMigrations :: [(Text, Text)]+idiomaticV2LabelMigrations =+  [ ("failureCode", "code"),+    ("failureDetail", "detail"),+    ("failureKey", "key"),+    ("failureSubject", "subject"),+    ("inboxFailureAttempt", "attempt"),+    ("inboxFailureReason", "reason"),+    ("reportDuplicate", "duplicate"),+    ("reportFailed", "failed"),+    ("reportFilled", "filled"),+    ("reportMissing", "missing"),+    ("reportPending", "pending"),+    ("reportRequired", "required"),+    ("reportStale", "stale"),+    ("reportUnverified", "unverified"),+    ("reportVerified", "verified"),+    ("requirementCommandName", "commandName"),+    ("requirementEventKinds", "eventKinds"),+    ("requirementEvidence", "evidence"),+    ("requirementExpectedEdge", "expectedEdge"),+    ("requirementGuardCoverage", "guardCoverage"),+    ("requirementKey", "key"),+    ("requirementKind", "kind"),+    ("requirementLine", "line"),+    ("requirementSource", "source"),+    ("requirementTarget", "target"),+    ("sourceColumn", "column"),+    ("sourceFile", "file"),+    ("sourceLine", "line"),+    ("witnessCommand", "command"),+    ("witnessExpected", "expected"),+    ("witnessHistory", "history"),+    ("witnessHistoryPrefix", "historyPrefix"),+    ("witnessKey", "key"),+    ("witnessObservedChunk", "observedChunk"),+    ("workflowFactAwaitLabels", "awaitLabels"),+    ("workflowFactBody", "body"),+    ("workflowFactIdField", "idField"),+    ("workflowFactIdVia", "idVia"),+    ("workflowFactName", "name"),+    ("workflowFactPatchIds", "patchIds")+  ]

keiro-dsl.cabal view

@@ -1,23 +1,41 @@-cabal-version:   3.0-name:            keiro-dsl-version:         0.14.0.0-synopsis:        Typed specification toolchain for keiro services+cabal-version:      3.0+name:               keiro-dsl+version:            0.15.0.0+synopsis:           Typed specification toolchain for keiro services description:   keiro-dsl is the toolchain over a typed `.keiro` specification of a keiro   service: a parser + checker + scaffolder + harness emitter. It emits the   symbol-free deterministic layer plus typed holes, never a keiki symbolic   operator (the firewall invariant). -license:         BSD-3-Clause-license-file:    LICENSE-author:          Nadeem Bitar-maintainer:      nadeem@gmail.com-copyright:       2026 Nadeem Bitar-category:        Development-build-type:      Simple-tested-with:     GHC >=9.12 && <9.13-extra-doc-files: CHANGELOG.md+license:            BSD-3-Clause+license-file:       LICENSE+author:             Nadeem Bitar+maintainer:         nadeem@gmail.com+copyright:          2026 Nadeem Bitar+category:           Development+build-type:         Simple+tested-with:        GHC >=9.12 && <9.13+extra-doc-files:+  CHANGELOG.md+  generated-haskell-edition-idiomatic-v2.md+  record-field-migration-0.15.md +-- The main package test is intentionally runnable from an unpacked source+-- distribution. Include its fixtures, compatibility manifests, mutation+-- scripts, and committed conformance corpus instead of relying on the+-- repository checkout surrounding this package.+extra-source-files:+  test/**/*.cabal+  test/**/*.golden+  test/**/*.hs+  test/**/*.json+  test/**/*.keiro+  test/**/*.keiro-workspace+  test/**/*.md+  test/**/*.sh+  test/**/*.txt+ common warnings   ghc-options: -Wall -Werror=missing-fields @@ -27,7 +45,9 @@     DuplicateRecordFields     ImportQualifiedPost     LambdaCase+    NoFieldSelectors     OverloadedLabels+    OverloadedRecordDot     OverloadedStrings  -- Every component importing this stanza compiles only `keiro-dsl scaffold`@@ -46,7 +66,11 @@  common generated-output   default-language:   GHC2024-  default-extensions: OverloadedStrings+  default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings    -- Published Languages 1-4 intentionally retain the frozen 0.11 ReadModel   -- spelling during the 0.12 migration window. Those generated bytes are not@@ -58,6 +82,16 @@   if flag(werror-generated)     ghc-options: -Werror +library generated-haskell-language-internal+  import:          warnings, shared+  visibility:      private+  hs-source-dirs:  internal+  exposed-modules: Keiro.Dsl.GeneratedHaskellLanguage+  build-depends:+    , base        >=4.21 && <5+    , containers  >=0.6  && <0.8+    , text        >=2.1  && <2.2+ library   import:          warnings, shared   hs-source-dirs:  src@@ -126,7 +160,6 @@     Keiro.Dsl.AggregateGenerationPlan     Keiro.Dsl.FieldIdentity     Keiro.Dsl.Frontend.Internal-    Keiro.Dsl.GeneratedHaskellLanguage     Keiro.Dsl.HaskellName     Keiro.Dsl.Parser.Aggregate     Keiro.Dsl.Parser.Coordination@@ -144,21 +177,22 @@     Paths_keiro_dsl    build-depends:-    , aeson               >=2.2.1     && <2.3-    , base                >=4.21      && <5-    , bytestring          >=0.12      && <0.13-    , containers          >=0.6       && <0.8-    , cryptohash-sha256   >=0.11.102  && <0.12-    , directory           >=1.3       && <1.4-    , filepath            >=1.4       && <1.6-    , keiki               >=0.9       && <0.10-    , keiro-core          ^>=0.14.0.0-    , megaparsec          >=9.6       && <9.9-    , mmzk-typeid         >=0.7       && <0.8-    , parser-combinators  >=1.3       && <1.4-    , prettyprinter       >=1.7       && <1.8-    , text                >=2.1       && <2.2-    , time                >=1.12      && <1.15+    , aeson                                          >=2.2.1     && <2.3+    , base                                           >=4.21      && <5+    , bytestring                                     >=0.12      && <0.13+    , containers                                     >=0.6       && <0.8+    , cryptohash-sha256                              >=0.11.102  && <0.12+    , directory                                      >=1.3       && <1.4+    , filepath                                       >=1.4       && <1.6+    , keiki                                          >=0.9       && <0.10+    , keiro-core                                     ^>=0.15.0.0+    , keiro-dsl:generated-haskell-language-internal+    , megaparsec                                     >=9.6       && <9.9+    , mmzk-typeid                                    >=0.7       && <0.8+    , parser-combinators                             >=1.3       && <1.4+    , prettyprinter                                  >=1.7       && <1.8+    , text                                           >=2.1       && <2.2+    , time                                           >=1.12      && <1.15  executable keiro-dsl   import:         warnings, shared@@ -190,19 +224,21 @@     Paths_keiro_dsl    build-depends:-    , aeson        >=2.2       && <2.3-    , base         >=4.21      && <5-    , containers   >=0.6       && <0.8-    , directory    >=1.3       && <1.4-    , filepath     >=1.4       && <1.6-    , hspec        >=2.11-    , keiki        >=0.9       && <0.10-    , keiro-core   ^>=0.14.0.0+    , aeson                                          >=2.2       && <2.3+    , base                                           >=4.21      && <5+    , bytestring                                     >=0.12      && <0.13+    , containers                                     >=0.6       && <0.8+    , directory                                      >=1.3       && <1.4+    , filepath                                       >=1.4       && <1.6+    , hspec                                          >=2.11+    , keiki                                          >=0.9       && <0.10+    , keiro-core                                     ^>=0.15.0.0     , keiro-dsl-    , mmzk-typeid  >=0.7       && <0.8-    , process      >=1.6       && <1.7-    , QuickCheck   >=2.14-    , text         >=2.1       && <2.2+    , keiro-dsl:generated-haskell-language-internal+    , mmzk-typeid                                    >=0.7       && <0.8+    , process                                        >=1.6       && <1.7+    , QuickCheck                                     >=2.14+    , text                                           >=2.1       && <2.2  test-suite keiro-dsl-import-planning-test   import:         warnings, shared

+ record-field-migration-0.15.md view

@@ -0,0 +1,1433 @@+# keiro-dsl record-field migration for 0.15++This checked inventory is the package-authored record migration contract for ExecPlan 177.+It validates every tracked Haskell source compiled through the `shared` Cabal stanza.+The current column preserves the released 0.14 spelling; the target column and all other+facts are derived from the live 0.15 source. Unchanged rows are intentional.+Product reads become record-dot projections, while single-field newtype unwrappers remain+explicit positional functions. The review-risk column is an omission detector: it flags+serialized, rendered, CLI, and runtime surfaces for review but does not prove byte+compatibility. Exact byte claims live in named package-test goldens.++Inventory: 286 record-owning declarations, 1412 fields, 1375 strict fields, and 1281 fields exported through a public `Type (..)`.++| Location | Owner | Kind | Public | Current | Target | Type/strictness | Selection replacement | Review risk / observable surface | Deriving |+| --- | --- | --- | --- | --- | --- | --- | --- | --- | --- |+| `keiro-dsl/src/Keiro/Dsl/AggregateGenerationPlan.hs:14` | `TransitionLayoutEntry` | data | no | `layoutDeclarationIndex` | `declarationIndex` | `!Int` | `(.declarationIndex)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateGenerationPlan.hs:15` | `TransitionLayoutEntry` | data | no | `layoutOutgoingIndex` | `outgoingIndex` | `!Int` | `(.outgoingIndex)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateGenerationPlan.hs:16` | `TransitionLayoutEntry` | data | no | `layoutTransition` | `transition` | `!Transition` | `(.transition)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:85` | `AggregateSymbols` | data | no | `symbolNominals` | `nominals` | `!(Map Name ResolvedNominalType)` | `(.nominals)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:86` | `AggregateSymbols` | data | no | `symbolVertices` | `vertices` | `!(Map Name [Name])` | `(.vertices)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:87` | `AggregateSymbols` | data | no | `symbolMapped` | `mapped` | `!(Map MappedKey ResolvedMappedDecl)` | `(.mapped)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:121` | `AggregateTypeError` | data | yes | `aggregateTypeErrorLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:122` | `AggregateTypeError` | data | yes | `aggregateTypeErrorUseSite` | `useSite` | `!AggregateUseSite` | `(.useSite)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:123` | `AggregateTypeError` | data | yes | `aggregateTypeErrorReason` | `reason` | `!AggregateTypeErrorReason` | `(.reason)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:251` | `AggregateHaskellSource` | data | no | `aggregateSourceBuiltin` | `builtin` | `!(Maybe Text)` | `(.builtin)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:252` | `AggregateHaskellSource` | data | no | `aggregateSourceReference` | `reference` | `!(Maybe HaskellReference)` | `(.reference)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/AggregateType.hs:253` | `AggregateHaskellSource` | data | no | `aggregateSourceStaticImports` | `staticImports` | `!(Set Text)` | `(.staticImports)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:51` | `BehaviorKey` | newtype | yes | `unBehaviorKey` | `unBehaviorKey` | `Text` | explicit `unBehaviorKey` positional function | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:92` | `BehaviorExactLocation` | data | yes | `exactSourceFile` | `sourceFile` | `!FilePath` | `(.sourceFile)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:93` | `BehaviorExactLocation` | data | yes | `exactSourceLine` | `sourceLine` | `!Int` | `(.sourceLine)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:94` | `BehaviorExactLocation` | data | yes | `exactSourceColumn` | `sourceColumn` | `!Int` | `(.sourceColumn)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:99` | `BehaviorRequirement` | data | yes | `requirementKey` | `key` | `!BehaviorKey` | `(.key)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:100` | `BehaviorRequirement` | data | yes | `requirementOrigin` | `origin` | `!RequirementOrigin` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:101` | `BehaviorRequirement` | data | yes | `requirementKind` | `kind` | `!ObligationKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:102` | `BehaviorRequirement` | data | yes | `requirementEvidence` | `evidence` | `!EvidenceLevel` | `(.evidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:103` | `BehaviorRequirement` | data | yes | `requirementGuardCoverage` | `guardCoverage` | `!GuardCoverage` | `(.guardCoverage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:104` | `BehaviorRequirement` | data | yes | `requirementContext` | `context` | `!Name` | `(.context)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:105` | `BehaviorRequirement` | data | yes | `requirementAggregate` | `aggregate` | `!Name` | `(.aggregate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:106` | `BehaviorRequirement` | data | yes | `requirementSource` | `source` | `!Name` | `(.source)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:107` | `BehaviorRequirement` | data | yes | `requirementCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:108` | `BehaviorRequirement` | data | yes | `requirementTarget` | `target` | `!(Maybe Name)` | `(.target)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:109` | `BehaviorRequirement` | data | yes | `requirementMode` | `mode` | `!(Maybe TransitionMode)` | `(.mode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:110` | `BehaviorRequirement` | data | yes | `requirementEvents` | `events` | `![Name]` | `(.events)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:111` | `BehaviorRequirement` | data | yes | `requirementOutputs` | `outputs` | `![OutputEvidence]` | `(.outputs)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:112` | `BehaviorRequirement` | data | yes | `requirementDomainOutcome` | `domainOutcome` | `!(Maybe TransitionOutcome)` | `(.domainOutcome)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:113` | `BehaviorRequirement` | data | yes | `requirementLocation` | `location` | `!Loc` | `(.location)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:114` | `BehaviorRequirement` | data | yes | `requirementExactLocation` | `exactLocation` | `!(Maybe BehaviorExactLocation)` | `(.exactLocation)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:115` | `BehaviorRequirement` | data | yes | `requirementOwner` | `owner` | `!(Maybe FilePath)` | `(.owner)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:116` | `BehaviorRequirement` | data | yes | `requirementCanonical` | `canonical` | `!Text` | `(.canonical)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:124` | `BehaviorRecordRow` | data | yes | `behaviorRecordKey` | `key` | `!BehaviorKey` | `(.key)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:125` | `BehaviorRecordRow` | data | yes | `behaviorRecordKind` | `kind` | `!ObligationKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:126` | `BehaviorRecordRow` | data | yes | `behaviorRecordEvidence` | `evidence` | `!EvidenceLevel` | `(.evidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:127` | `BehaviorRecordRow` | data | yes | `behaviorRecordAggregate` | `aggregate` | `!Name` | `(.aggregate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:128` | `BehaviorRecordRow` | data | yes | `behaviorRecordSource` | `source` | `!Name` | `(.source)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:129` | `BehaviorRecordRow` | data | yes | `behaviorRecordCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:130` | `BehaviorRecordRow` | data | yes | `behaviorRecordOwner` | `owner` | `!(Maybe FilePath)` | `(.owner)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:131` | `BehaviorRecordRow` | data | yes | `behaviorRecordOutputs` | `outputs` | `![OutputEvidence]` | `(.outputs)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:143` | `BehaviorObligationsReport` | data | yes | `behaviorSubject` | `subject` | `!FilePath` | `(.subject)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:144` | `BehaviorObligationsReport` | data | yes | `behaviorWorkspaceService` | `workspaceService` | `!(Maybe Text)` | `(.workspaceService)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorCoverage.hs:145` | `BehaviorObligationsReport` | data | yes | `behaviorRequirements` | `requirements` | `![BehaviorRequirement]` | `(.requirements)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:38` | `BehaviorSourceFailure` | data | yes | `failureCode` | `code` | `!BehaviorSourceFailureCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:39` | `BehaviorSourceFailure` | data | yes | `failureKey` | `key` | `!BehaviorKey` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:40` | `BehaviorSourceFailure` | data | yes | `failureOrigin` | `origin` | `!RequirementOrigin` | `(.origin)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:41` | `BehaviorSourceFailure` | data | yes | `failureAggregate` | `aggregate` | `!Text` | `(.aggregate)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:42` | `BehaviorSourceFailure` | data | yes | `failureState` | `state` | `!Text` | `(.state)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:43` | `BehaviorSourceFailure` | data | yes | `failureCommand` | `command` | `!Text` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:44` | `BehaviorSourceFailure` | data | yes | `failureSourceSubject` | `sourceSubject` | `!SourceSubject` | `(.sourceSubject)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:45` | `BehaviorSourceFailure` | data | yes | `failureSpan` | `span` | `!(Maybe SourceSpan)` | `(.span)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:46` | `BehaviorSourceFailure` | data | yes | `failureMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:51` | `BehaviorSourceEntry` | data | yes | `behaviorSourceKey` | `key` | `!BehaviorKey` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:52` | `BehaviorSourceEntry` | data | yes | `behaviorSourceFile` | `file` | `!FilePath` | `(.file)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:53` | `BehaviorSourceEntry` | data | yes | `behaviorSourceLine` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/BehaviorSourceMap.hs:54` | `BehaviorSourceEntry` | data | yes | `behaviorSourceColumn` | `column` | `!Int` | `(.column)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:41` | `CheckReportLanguage` | data | yes | `reportSourceForm` | `sourceForm` | `!Text` | `(.sourceForm)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:42` | `CheckReportLanguage` | data | yes | `reportDeclaredLanguageVersion` | `declaredLanguageVersion` | `!(Maybe LanguageVersion)` | `(.declaredLanguageVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:43` | `CheckReportLanguage` | data | yes | `reportEffectiveLanguageVersion` | `effectiveLanguageVersion` | `!LanguageVersion` | `(.effectiveLanguageVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:44` | `CheckReportLanguage` | data | yes | `reportRuntimeSemantics` | `runtimeSemantics` | `!Text` | `(.runtimeSemantics)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:45` | `CheckReportLanguage` | data | yes | `reportLanguageSupport` | `languageSupport` | `!LanguageSupport` | `(.languageSupport)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:46` | `CheckReportLanguage` | data | yes | `reportStable` | `stable` | `!Bool` | `(.stable)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:51` | `CheckReportEnforcement` | data | yes | `reportMinLanguage` | `minLanguage` | `!(Maybe LanguageVersion)` | `(.minLanguage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:52` | `CheckReportEnforcement` | data | yes | `reportDenyWarnings` | `denyWarnings` | `!Bool` | `(.denyWarnings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:53` | `CheckReportEnforcement` | data | yes | `reportDenyCodes` | `denyCodes` | `![DiagnosticCode]` | `(.denyCodes)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:58` | `CheckReportRelated` | data | yes | `relatedFile` | `file` | `!FilePath` | `(.file)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:59` | `CheckReportRelated` | data | yes | `relatedLine` | `line` | `!Int` | `(.line)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:60` | `CheckReportRelated` | data | yes | `relatedNote` | `note` | `!Text` | `(.note)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:65` | `CheckReportEntry` | data | yes | `entryCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:66` | `CheckReportEntry` | data | yes | `entrySeverity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:67` | `CheckReportEntry` | data | yes | `entryFile` | `file` | `!FilePath` | `(.file)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:68` | `CheckReportEntry` | data | yes | `entryLine` | `line` | `!Int` | `(.line)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:69` | `CheckReportEntry` | data | yes | `entryMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:70` | `CheckReportEntry` | data | yes | `entryDenied` | `denied` | `!Bool` | `(.denied)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:71` | `CheckReportEntry` | data | yes | `entryRelated` | `related` | `![CheckReportRelated]` | `(.related)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:76` | `CheckReportSummary` | data | yes | `summaryErrors` | `errors` | `!Int` | `(.errors)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:77` | `CheckReportSummary` | data | yes | `summaryWarnings` | `warnings` | `!Int` | `(.warnings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:78` | `CheckReportSummary` | data | yes | `summaryDeniedWarnings` | `deniedWarnings` | `!Int` | `(.deniedWarnings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:83` | `CheckReportMember` | data | yes | `memberPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:84` | `CheckReportMember` | data | yes | `memberSourceForm` | `sourceForm` | `!Text` | `(.sourceForm)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:85` | `CheckReportMember` | data | yes | `memberDeclaredLanguageVersion` | `declaredLanguageVersion` | `!(Maybe LanguageVersion)` | `(.declaredLanguageVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:93` | `CheckReport` | data | no | `reportKind` | `kind` | `!CheckReportKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:94` | `CheckReport` | data | no | `reportSubject` | `subject` | `!FilePath` | `(.subject)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:98` | `CheckReport` | data | no | `reportLanguage` | `language` | `!(Maybe CheckReportLanguage)` | `(.language)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:99` | `CheckReport` | data | no | `reportEnforcement` | `enforcement` | `!CheckReportEnforcement` | `(.enforcement)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:100` | `CheckReport` | data | no | `reportDiagnostics` | `diagnostics` | `![CheckReportEntry]` | `(.diagnostics)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:101` | `CheckReport` | data | no | `reportSummary` | `summary` | `!CheckReportSummary` | `(.summary)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:102` | `CheckReport` | data | no | `reportOk` | `ok` | `!Bool` | `(.ok)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CheckReport.hs:103` | `CheckReport` | data | no | `reportMembers` | `members` | `![CheckReportMember]` | `(.members)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:70` | `JsonPointer` | newtype | yes | `unJsonPointer` | `unJsonPointer` | `Text` | explicit `unJsonPointer` positional function | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:85` | `HistoricalCodec` | data | yes | `hcIdentity` | `identity` | `!Text` | `(.identity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:86` | `HistoricalCodec` | data | yes | `hcVersion` | `version` | `!Text` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:87` | `HistoricalCodec` | data | yes | `hcEncode` | `encode` | `!(a -> Value)` | `(.encode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:88` | `HistoricalCodec` | data | yes | `hcDecode` | `decode` | `!(Value -> Either Text a)` | `(.decode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:93` | `CompareObservation` | data | yes | `coCaseName` | `caseName` | `!Text` | `(.caseName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:94` | `CompareObservation` | data | yes | `coHistoricalValue` | `historicalValue` | `!Value` | `(.historicalValue)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:95` | `CompareObservation` | data | yes | `coGeneratedValue` | `generatedValue` | `!Value` | `(.generatedValue)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:98` | `CompareObservation` | data | yes | `coFixturePath` | `fixturePath` | `!FilePath` | `(.fixturePath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:99` | `CompareObservation` | data | yes | `coInputValue` | `inputValue` | `!Value` | `(.inputValue)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:100` | `CompareObservation` | data | yes | `coHistoricalDecode` | `historicalDecode` | `!DecodeOutcome` | `(.historicalDecode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:101` | `CompareObservation` | data | yes | `coGeneratedDecode` | `generatedDecode` | `!DecodeOutcome` | `(.generatedDecode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:124` | `DeclaredBranch` | data | yes | `dbOrigin` | `origin` | `!FixtureOrigin` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:125` | `DeclaredBranch` | data | yes | `dbPointer` | `pointer` | `!JsonPointer` | `(.pointer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:126` | `DeclaredBranch` | data | yes | `dbKind` | `kind` | `!BranchKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:131` | `ObservedBranch` | data | yes | `obOrigin` | `origin` | `!FixtureOrigin` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:132` | `ObservedBranch` | data | yes | `obPointer` | `pointer` | `!JsonPointer` | `(.pointer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:133` | `ObservedBranch` | data | yes | `obKind` | `kind` | `!BranchKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:138` | `CoverageGap` | data | yes | `cgOrigin` | `origin` | `!FixtureOrigin` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:139` | `CoverageGap` | data | yes | `cgPointer` | `pointer` | `!JsonPointer` | `(.pointer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:140` | `CoverageGap` | data | yes | `cgKind` | `kind` | `!BranchKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:157` | `BranchField` | data | yes | `bfWireKey` | `wireKey` | `!Text` | `(.wireKey)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:158` | `BranchField` | data | yes | `bfPresenceOptional` | `presenceOptional` | `!Bool` | `(.presenceOptional)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:159` | `BranchField` | data | yes | `bfSchema` | `schema` | `!BranchSchema` | `(.schema)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:164` | `BranchArm` | data | yes | `baWireTag` | `wireTag` | `!Text` | `(.wireTag)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:165` | `BranchArm` | data | yes | `baPayloadSchema` | `payloadSchema` | `!(Maybe BranchSchema)` | `(.payloadSchema)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:170` | `CompareProvenance` | data | yes | `cpHistoricalCodecIdentity` | `historicalCodecIdentity` | `!Text` | `(.historicalCodecIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:171` | `CompareProvenance` | data | yes | `cpHistoricalCodecVersion` | `historicalCodecVersion` | `!Text` | `(.historicalCodecVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:172` | `CompareProvenance` | data | yes | `cpCanonicalType` | `canonicalType` | `!CanonicalTypeId` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:173` | `CompareProvenance` | data | yes | `cpBindingSymbol` | `bindingSymbol` | `!QualifiedValueName` | `(.bindingSymbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:174` | `CompareProvenance` | data | yes | `cpBindingVersion` | `bindingVersion` | `!BindingVersion` | `(.bindingVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:175` | `CompareProvenance` | data | yes | `cpWireFingerprint` | `wireFingerprint` | `!Text` | `(.wireFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:180` | `ClassifiedObservation` | data | yes | `classifiedOrigin` | `origin` | `!FixtureOrigin` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:181` | `ClassifiedObservation` | data | yes | `classifiedName` | `name` | `!Text` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:182` | `ClassifiedObservation` | data | yes | `classifiedVerdict` | `verdict` | `!FixtureVerdict` | `(.verdict)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:187` | `CompareReport` | data | yes | `crProvenance` | `provenance` | `!CompareProvenance` | `(.provenance)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:188` | `CompareReport` | data | yes | `crObservations` | `observations` | `![ClassifiedObservation]` | `(.observations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:189` | `CompareReport` | data | yes | `crInputIssues` | `inputIssues` | `![CompareInputIssue]` | `(.inputIssues)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:190` | `CompareReport` | data | yes | `crCoverageGaps` | `coverageGaps` | `![CoverageGap]` | `(.coverageGaps)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:191` | `CompareReport` | data | yes | `crAuthority` | `authority` | `!Text` | `(.authority)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:196` | `ReportWriteError` | data | yes | `reportWritePath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/CodecCompare.hs:197` | `ReportWriteError` | data | yes | `reportWriteMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:58` | `ConformanceFile` | data | yes | `conformanceFilePath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:59` | `ConformanceFile` | data | yes | `conformanceFileText` | `text` | `!Text` | `(.text)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:60` | `ConformanceFile` | data | yes | `conformanceFileKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:65` | `ConformancePackagePlan` | data | yes | `cppServiceKey` | `serviceKey` | `!ConformanceServiceKey` | `(.serviceKey)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:66` | `ConformancePackagePlan` | data | yes | `cppDirectory` | `directory` | `!FilePath` | `(.directory)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:67` | `ConformancePackagePlan` | data | yes | `cppPackageName` | `packageName` | `!Text` | `(.packageName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:68` | `ConformancePackagePlan` | data | yes | `cppRuntimePackage` | `runtimePackage` | `!RuntimePackageName` | `(.runtimePackage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:69` | `ConformancePackagePlan` | data | yes | `cppFacadeModule` | `facadeModule` | `!Text` | `(.facadeModule)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:70` | `ConformancePackagePlan` | data | yes | `cppFiles` | `files` | `![ConformanceFile]` | `(.files)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:78` | `DuplicateFactKey` | data | yes | `duplicateFactSide` | `side` | `!ConformanceFactSide` | `(.side)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:79` | `DuplicateFactKey` | data | yes | `duplicateFactKey` | `key` | `!String` | `(.key)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:101` | `ConformancePackageRecord` | data | yes | `cprSchema` | `schema` | `!Int` | `(.schema)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:102` | `ConformancePackageRecord` | data | yes | `cprServiceKey` | `serviceKey` | `!ConformanceServiceKey` | `(.serviceKey)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:103` | `ConformancePackageRecord` | data | yes | `cprRuntimePackage` | `runtimePackage` | `!RuntimePackageName` | `(.runtimePackage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:104` | `ConformancePackageRecord` | data | yes | `cprFacadeModule` | `facadeModule` | `!Text` | `(.facadeModule)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:105` | `ConformancePackageRecord` | data | yes | `cprFiles` | `files` | `![(ModuleKind, FilePath)]` | `(.files)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:113` | `ConformanceStaleFile` | data | yes | `conformanceStaleKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:114` | `ConformanceStaleFile` | data | yes | `conformanceStalePath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:115` | `ConformanceStaleFile` | data | yes | `conformanceStaleBannerPresent` | `bannerPresent` | `!(Maybe Bool)` | `(.bannerPresent)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:120` | `PreparedConformancePackage` | data | no | `preparedRoot` | `root` | `!FilePath` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:121` | `PreparedConformancePackage` | data | no | `preparedPlan` | `plan` | `!ConformancePackagePlan` | `(.plan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:122` | `PreparedConformancePackage` | data | no | `preparedStale` | `stale` | `![ConformanceStaleFile]` | `(.stale)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:127` | `ConformancePackageReport` | data | yes | `conformanceReportRoot` | `root` | `!FilePath` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:128` | `ConformancePackageReport` | data | yes | `conformanceReportPlan` | `plan` | `!ConformancePackagePlan` | `(.plan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:129` | `ConformancePackageReport` | data | yes | `conformanceReportDispositions` | `dispositions` | `![(ConformanceFile, ConformanceWriteDisposition)]` | `(.dispositions)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:130` | `ConformancePackageReport` | data | yes | `conformanceReportStale` | `stale` | `![ConformanceStaleFile]` | `(.stale)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:388` | `ConformanceFileRow` | data | no | `conformanceRowKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConformancePackage.hs:389` | `ConformanceFileRow` | data | no | `conformanceRowPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:27` | `HaskellTypeOccurrence` | newtype | yes | `unHaskellTypeOccurrence` | `unHaskellTypeOccurrence` | `Text` | explicit `unHaskellTypeOccurrence` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:38` | `ImportRequirement` | data | yes | `package` | `package` | `!Text` | `(.package)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:39` | `ImportRequirement` | data | yes | `moduleName` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:40` | `ImportRequirement` | data | yes | `occurrence` | `occurrence` | `!Text` | `(.occurrence)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:45` | `ConsumerTypePlan` | data | yes | `haskellType` | `haskellType` | `!HaskellTypeOccurrence` | `(.haskellType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:46` | `ConsumerTypePlan` | data | yes | `imports` | `imports` | `![ImportRequirement]` | `(.imports)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:47` | `ConsumerTypePlan` | data | yes | `dependencies` | `dependencies` | `!(Set MappedKey)` | `(.dependencies)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:126` | `RenderedType` | data | no | `rendered` | `rendered` | `!Text` | `(.rendered)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:127` | `RenderedType` | data | no | `precedence` | `precedence` | `!TypePrecedence` | `(.precedence)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:128` | `RenderedType` | data | no | `requirements` | `requirements` | `!(Set ImportRequirement)` | `(.requirements)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ConsumerTypePlan.hs:129` | `RenderedType` | data | no | `mappedDependencies` | `mappedDependencies` | `!(Set MappedKey)` | `(.mappedDependencies)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:60` | `RouterSelectionSnapshot` | data | yes | `selectionRouter` | `router` | `!Name` | `(.router)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:61` | `RouterSelectionSnapshot` | data | yes | `selectionVerification` | `verification` | `!SelectionVerification` | `(.verification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:62` | `RouterSelectionSnapshot` | data | yes | `selectionIdentity` | `identity` | `!(Maybe Text)` | `(.identity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:63` | `RouterSelectionSnapshot` | data | yes | `selectionVersion` | `version` | `!(Maybe Natural)` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:64` | `RouterSelectionSnapshot` | data | yes | `selectionFingerprint` | `fingerprint` | `!(Maybe Text)` | `(.fingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:69` | `CoordinationImpact` | data | yes | `coordinationRouter` | `router` | `!Name` | `(.router)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:70` | `CoordinationImpact` | data | yes | `coordinationSeverity` | `severity` | `!CoordinationSeverity` | `(.severity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:71` | `CoordinationImpact` | data | yes | `coordinationReason` | `reason` | `!CoordinationReason` | `(.reason)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:72` | `CoordinationImpact` | data | yes | `previousVerification` | `previousVerification` | `!SelectionVerification` | `(.previousVerification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:73` | `CoordinationImpact` | data | yes | `currentVerification` | `currentVerification` | `!SelectionVerification` | `(.currentVerification)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:74` | `CoordinationImpact` | data | yes | `previousIdentity` | `previousIdentity` | `!(Maybe Text)` | `(.previousIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:75` | `CoordinationImpact` | data | yes | `currentIdentity` | `currentIdentity` | `!(Maybe Text)` | `(.currentIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:76` | `CoordinationImpact` | data | yes | `previousVersion` | `previousVersion` | `!(Maybe Natural)` | `(.previousVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:77` | `CoordinationImpact` | data | yes | `currentVersion` | `currentVersion` | `!(Maybe Natural)` | `(.currentVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:78` | `CoordinationImpact` | data | yes | `previousFingerprint` | `previousFingerprint` | `!(Maybe Text)` | `(.previousFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:79` | `CoordinationImpact` | data | yes | `currentFingerprint` | `currentFingerprint` | `!(Maybe Text)` | `(.currentFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:80` | `CoordinationImpact` | data | yes | `affectedUseSites` | `affectedUseSites` | `![UseSite]` | `(.affectedUseSites)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:85` | `RouterSelectionDrift` | data | yes | `driftRouter` | `router` | `!Name` | `(.router)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:86` | `RouterSelectionDrift` | data | yes | `driftPreviousSelection` | `previousSelection` | `!(Maybe RouterSelectionSnapshot)` | `(.previousSelection)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:87` | `RouterSelectionDrift` | data | yes | `driftCurrentSelection` | `currentSelection` | `!(Maybe RouterSelectionSnapshot)` | `(.currentSelection)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:204` | `RouterSelectionState` | data | no | `stateSnapshot` | `snapshot` | `!RouterSelectionSnapshot` | `(.snapshot)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/CoordinationImpact.hs:205` | `RouterSelectionState` | data | no | `stateUseSites` | `useSites` | `![UseSite]` | `(.useSites)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:66` | `CoverageRoot` | data | yes | `rootSurface` | `surface` | `!CoverageSurface` | `(.surface)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:67` | `CoverageRoot` | data | yes | `rootConsumer` | `consumer` | `!Text` | `(.consumer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:68` | `CoverageRoot` | data | yes | `rootPath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:69` | `CoverageRoot` | data | yes | `rootMappedType` | `mappedType` | `!Text` | `(.mappedType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:70` | `CoverageRoot` | data | yes | `rootMode` | `mode` | `!CoverageMode` | `(.mode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:71` | `CoverageRoot` | data | yes | `rootCanonicalType` | `canonicalType` | `!(Maybe Text)` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:72` | `CoverageRoot` | data | yes | `rootCodecIdentity` | `codecIdentity` | `!(Maybe Text)` | `(.codecIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:73` | `CoverageRoot` | data | yes | `rootCodecVersion` | `codecVersion` | `!(Maybe Text)` | `(.codecVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:74` | `CoverageRoot` | data | yes | `rootWireFingerprint` | `wireFingerprint` | `!Text` | `(.wireFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:79` | `StructuralBoundary` | data | yes | `structuralRoot` | `root` | `!Text` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:80` | `StructuralBoundary` | data | yes | `structuralPath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:81` | `StructuralBoundary` | data | yes | `structuralMappedType` | `mappedType` | `!Text` | `(.mappedType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:82` | `StructuralBoundary` | data | yes | `structuralCanonicalType` | `canonicalType` | `!Text` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:83` | `StructuralBoundary` | data | yes | `structuralWireFingerprint` | `wireFingerprint` | `!Text` | `(.wireFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:88` | `OpaqueBoundary` | data | yes | `opaqueRoot` | `root` | `!Text` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:89` | `OpaqueBoundary` | data | yes | `opaquePath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:90` | `OpaqueBoundary` | data | yes | `opaqueMappedType` | `mappedType` | `!Text` | `(.mappedType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:91` | `OpaqueBoundary` | data | yes | `opaqueCodecIdentity` | `codecIdentity` | `!Text` | `(.codecIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:92` | `OpaqueBoundary` | data | yes | `opaqueCodecVersion` | `codecVersion` | `!Text` | `(.codecVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:97` | `JsonBoundary` | data | yes | `jsonSurface` | `surface` | `!CoverageSurface` | `(.surface)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:98` | `JsonBoundary` | data | yes | `jsonRoot` | `root` | `!Text` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:99` | `JsonBoundary` | data | yes | `jsonPath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:104` | `SnapshotBoundary` | data | yes | `snapshotRoot` | `root` | `!Text` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:105` | `SnapshotBoundary` | data | yes | `snapshotAggregate` | `aggregate` | `!Text` | `(.aggregate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:106` | `SnapshotBoundary` | data | yes | `snapshotRegister` | `register` | `!Text` | `(.register)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:107` | `SnapshotBoundary` | data | yes | `snapshotMappedType` | `mappedType` | `!Text` | `(.mappedType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:108` | `SnapshotBoundary` | data | yes | `snapshotMode` | `mode` | `!CoverageMode` | `(.mode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:109` | `SnapshotBoundary` | data | yes | `snapshotEncoding` | `encoding` | `!Text` | `(.encoding)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:110` | `SnapshotBoundary` | data | yes | `snapshotInvalidation` | `invalidation` | `!Text` | `(.invalidation)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:111` | `SnapshotBoundary` | data | yes | `snapshotWireFingerprint` | `wireFingerprint` | `!Text` | `(.wireFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:112` | `SnapshotBoundary` | data | yes | `snapshotEnabled` | `enabled` | `!Bool` | `(.enabled)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:117` | `UnsupportedSurface` | data | yes | `unsupportedSurface` | `surface` | `!Text` | `(.surface)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:118` | `UnsupportedSurface` | data | yes | `unsupportedSupport` | `support` | `!Text` | `(.support)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:119` | `UnsupportedSurface` | data | yes | `unsupportedReason` | `reason` | `!Text` | `(.reason)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:124` | `CoverageCounts` | data | yes | `totalRoots` | `totalRoots` | `!Int` | `(.totalRoots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:125` | `CoverageCounts` | data | yes | `structuralRoots` | `structuralRoots` | `!Int` | `(.structuralRoots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:126` | `CoverageCounts` | data | yes | `opaqueRoots` | `opaqueRoots` | `!Int` | `(.opaqueRoots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:127` | `CoverageCounts` | data | yes | `jsonBoundaries` | `jsonBoundaries` | `!Int` | `(.jsonBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:132` | `CoverageSummary` | data | yes | `aggregateCommandPayloads` | `aggregateCommandPayloads` | `!CoverageCounts` | `(.aggregateCommandPayloads)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:133` | `CoverageSummary` | data | yes | `privateEventPayloads` | `privateEventPayloads` | `!CoverageCounts` | `(.privateEventPayloads)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:134` | `CoverageSummary` | data | yes | `snapshotRegisters` | `snapshotRegisters` | `!CoverageCounts` | `(.snapshotRegisters)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:135` | `CoverageSummary` | data | yes | `workqueuePayloads` | `workqueuePayloads` | `!CoverageCounts` | `(.workqueuePayloads)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:136` | `CoverageSummary` | data | yes | `readModelQueryInputs` | `readModelQueryInputs` | `!CoverageCounts` | `(.readModelQueryInputs)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:137` | `CoverageSummary` | data | yes | `readModelQueryResults` | `readModelQueryResults` | `!CoverageCounts` | `(.readModelQueryResults)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:138` | `CoverageSummary` | data | yes | `projectionTypedConsumers` | `projectionTypedConsumers` | `!CoverageCounts` | `(.projectionTypedConsumers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:143` | `CoverageFinding` | data | yes | `findingSeverity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:144` | `CoverageFinding` | data | yes | `findingCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:145` | `CoverageFinding` | data | yes | `findingRoots` | `roots` | `![Text]` | `(.roots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:146` | `CoverageFinding` | data | yes | `findingMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:151` | `CoveragePrevious` | data | yes | `previousReference` | `reference` | `!Text` | `(.reference)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:152` | `CoveragePrevious` | data | yes | `previousSummary` | `summary` | `!CoverageSummary` | `(.summary)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:153` | `CoveragePrevious` | data | yes | `previousOpaqueBoundaries` | `opaqueBoundaries` | `![OpaqueBoundary]` | `(.opaqueBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:158` | `CoverageDelta` | data | yes | `aggregateCommandRootDelta` | `aggregateCommandRootDelta` | `!Int` | `(.aggregateCommandRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:159` | `CoverageDelta` | data | yes | `privateEventRootDelta` | `privateEventRootDelta` | `!Int` | `(.privateEventRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:160` | `CoverageDelta` | data | yes | `snapshotRegisterRootDelta` | `snapshotRegisterRootDelta` | `!Int` | `(.snapshotRegisterRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:161` | `CoverageDelta` | data | yes | `workqueuePayloadRootDelta` | `workqueuePayloadRootDelta` | `!Int` | `(.workqueuePayloadRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:162` | `CoverageDelta` | data | yes | `readModelQueryInputRootDelta` | `readModelQueryInputRootDelta` | `!Int` | `(.readModelQueryInputRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:163` | `CoverageDelta` | data | yes | `readModelQueryResultRootDelta` | `readModelQueryResultRootDelta` | `!Int` | `(.readModelQueryResultRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:164` | `CoverageDelta` | data | yes | `projectionTypedConsumerRootDelta` | `projectionTypedConsumerRootDelta` | `!Int` | `(.projectionTypedConsumerRootDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:165` | `CoverageDelta` | data | yes | `opaqueBoundaryDelta` | `opaqueBoundaryDelta` | `!Int` | `(.opaqueBoundaryDelta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:166` | `CoverageDelta` | data | yes | `addedOpaqueBoundaries` | `addedOpaqueBoundaries` | `![OpaqueBoundary]` | `(.addedOpaqueBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:167` | `CoverageDelta` | data | yes | `removedOpaqueBoundaries` | `removedOpaqueBoundaries` | `![OpaqueBoundary]` | `(.removedOpaqueBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:172` | `CoverageReport` | data | yes | `coverageSpec` | `spec` | `!FilePath` | `(.spec)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:173` | `CoverageReport` | data | yes | `coverageRoots` | `roots` | `![CoverageRoot]` | `(.roots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:174` | `CoverageReport` | data | yes | `coverageStructuralBoundaries` | `structuralBoundaries` | `![StructuralBoundary]` | `(.structuralBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:175` | `CoverageReport` | data | yes | `coverageOpaqueBoundaries` | `opaqueBoundaries` | `![OpaqueBoundary]` | `(.opaqueBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:176` | `CoverageReport` | data | yes | `coverageJsonBoundaries` | `jsonBoundaries` | `![JsonBoundary]` | `(.jsonBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:177` | `CoverageReport` | data | yes | `coverageSnapshotBoundaries` | `snapshotBoundaries` | `![SnapshotBoundary]` | `(.snapshotBoundaries)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:178` | `CoverageReport` | data | yes | `coverageUnsupportedSurfaces` | `unsupportedSurfaces` | `![UnsupportedSurface]` | `(.unsupportedSurfaces)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:179` | `CoverageReport` | data | yes | `coverageSummary` | `summary` | `!CoverageSummary` | `(.summary)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:180` | `CoverageReport` | data | yes | `coverageFindings` | `findings` | `![CoverageFinding]` | `(.findings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:181` | `CoverageReport` | data | yes | `coveragePrevious` | `previous` | `!(Maybe CoveragePrevious)` | `(.previous)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Coverage.hs:182` | `CoverageReport` | data | yes | `coverageDelta` | `delta` | `!(Maybe CoverageDelta)` | `(.delta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:134` | `CompatibilityVector` | data | yes | `cvPrivateHistoryRead` | `privateHistoryRead` | `!SurfaceVerdict` | `(.privateHistoryRead)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:135` | `CompatibilityVector` | data | yes | `cvOldBinaryReadNewEvents` | `oldBinaryReadNewEvents` | `!SurfaceVerdict` | `(.oldBinaryReadNewEvents)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:136` | `CompatibilityVector` | data | yes | `cvSnapshotHydration` | `snapshotHydration` | `!SurfaceVerdict` | `(.snapshotHydration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:137` | `CompatibilityVector` | data | yes | `cvPublicConsumer` | `publicConsumer` | `!SurfaceVerdict` | `(.publicConsumer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:138` | `CompatibilityVector` | data | yes | `cvPersistedIdentity` | `persistedIdentity` | `!SurfaceVerdict` | `(.persistedIdentity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:139` | `CompatibilityVector` | data | yes | `cvConsumerBuild` | `consumerBuild` | `!SurfaceVerdict` | `(.consumerBuild)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:140` | `CompatibilityVector` | data | yes | `cvRollout` | `rollout` | `!(Set RolloutConstraint)` | `(.rollout)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:153` | `MappedPersistedImpact` | data | yes | `mappedPersistedSurface` | `surface` | `!MappedPersistedSurface` | `(.surface)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:154` | `MappedPersistedImpact` | data | yes | `mappedPersistedVerdict` | `verdict` | `!SurfaceVerdict` | `(.verdict)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:172` | `ChangeContext` | data | no | `changeContextRoot` | `root` | `!Name` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:173` | `ChangeContext` | data | no | `changeContextPaths` | `paths` | `![Text]` | `(.paths)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:174` | `ChangeContext` | data | no | `contextKind` | `contextKind` | `!ContextKind` | `(.contextKind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:175` | `ChangeContext` | data | no | `contextOriginalLabel` | `contextOriginalLabel` | `!Label` | `(.contextOriginalLabel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:186` | `ChangeKind` | data | yes | `ckNode` | `node` | `!Name` | `(.node)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:187` | `ChangeKind` | data | yes | `ckFacet` | `facet` | `!Text` | `(.facet)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:188` | `ChangeKind` | data | yes | `ckSubject` | `subject` | `!Text` | `(.subject)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:189` | `ChangeKind` | data | yes | `ckCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:190` | `ChangeKind` | data | yes | `ckContext` | `context` | `!ChangeContext` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:191` | `ChangeKind` | data | yes | `ckVector` | `vector` | `!CompatibilityVector` | `(.vector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:192` | `ChangeKind` | data | yes | `ckMappedPersistedImpact` | `mappedPersistedImpact` | `!(Maybe MappedPersistedImpact)` | `(.mappedPersistedImpact)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:193` | `ChangeKind` | data | yes | `ckMappedConsequences` | `mappedConsequences` | `!(Set MappedConsequence)` | `(.mappedConsequences)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:194` | `ChangeKind` | data | yes | `ckPaths` | `paths` | `![Text]` | `(.paths)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:195` | `ChangeKind` | data | yes | `ckDetail` | `detail` | `!Text` | `(.detail)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:669` | `DiffEnv` | data | yes | `deOld` | `old` | `!Spec` | `(.old)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:670` | `DiffEnv` | data | yes | `deNew` | `new` | `!Spec` | `(.new)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:722` | `Paired` | data | yes | `prMatched` | `matched` | `![(n, n)]` | `(.matched)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:723` | `Paired` | data | yes | `prAdded` | `added` | `![n]` | `(.added)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:724` | `Paired` | data | yes | `prRemoved` | `removed` | `![n]` | `(.removed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1884` | `EventFieldSig` | data | no | `eventFieldDslName` | `dslName` | `!Name` | `(.dslName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1885` | `EventFieldSig` | data | no | `eventFieldSelector` | `selector` | `!Name` | `(.selector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1886` | `EventFieldSig` | data | no | `eventFieldWireKey` | `wireKey` | `!Text` | `(.wireKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Diff.hs:1887` | `EventFieldSig` | data | no | `eventFieldType` | `valueType` | `!(Maybe TypeExpr)` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:74` | `DiffReport` | data | no | `reportGate` | `gate` | `!(Set CompatibilitySurface)` | `(.gate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:75` | `DiffReport` | data | no | `reportFindings` | `findings` | `![Change]` | `(.findings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:76` | `DiffReport` | data | no | `reportSemanticImpact` | `semanticImpact` | `!(Maybe [MappedImpactDelta])` | `(.semanticImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:77` | `DiffReport` | data | no | `reportCoordinationImpact` | `coordinationImpact` | `!(Maybe [CoordinationImpact])` | `(.coordinationImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:97` | `OwnedSite` | data | yes | `osFile` | `file` | `!FilePath` | `(.file)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:98` | `OwnedSite` | data | yes | `osLine` | `line` | `!Int` | `(.line)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:104` | `WorkspaceChange` | data | yes | `wcChange` | `change` | `!Change` | `(.change)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:105` | `WorkspaceChange` | data | yes | `wcDeclarationSite` | `declarationSite` | `!(Maybe OwnedSite)` | `(.declarationSite)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:106` | `WorkspaceChange` | data | yes | `wcUseSites` | `useSites` | `![(Text, Maybe OwnedSite)]` | `(.useSites)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:112` | `WorkspaceMeta` | data | yes | `wmIdentity` | `identity` | `!Text` | `(.identity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:113` | `WorkspaceMeta` | data | yes | `wmManifest` | `manifest` | `!FilePath` | `(.manifest)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:114` | `WorkspaceMeta` | data | yes | `wmSince` | `since` | `!Text` | `(.since)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:115` | `WorkspaceMeta` | data | yes | `wmMembersOld` | `membersOld` | `![FilePath]` | `(.membersOld)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:116` | `WorkspaceMeta` | data | yes | `wmMembersNew` | `membersNew` | `![FilePath]` | `(.membersNew)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:117` | `WorkspaceMeta` | data | yes | `wmAdoptionBaseline` | `adoptionBaseline` | `!Bool` | `(.adoptionBaseline)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:122` | `WorkspaceDiffReport` | data | no | `workspaceReportMeta` | `meta` | `!WorkspaceMeta` | `(.meta)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:123` | `WorkspaceDiffReport` | data | no | `workspaceReportGate` | `gate` | `!(Set CompatibilitySurface)` | `(.gate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:124` | `WorkspaceDiffReport` | data | no | `workspaceReportFindings` | `findings` | `![WorkspaceChange]` | `(.findings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:125` | `WorkspaceDiffReport` | data | no | `workspaceReportSemanticImpact` | `semanticImpact` | `!(Maybe [MappedImpactDelta])` | `(.semanticImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/DiffReport.hs:126` | `WorkspaceDiffReport` | data | no | `workspaceReportCoordinationImpact` | `coordinationImpact` | `!(Maybe [CoordinationImpact])` | `(.coordinationImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:36` | `CheckedFieldCopy` | data | yes | `outputSelector` | `outputSelector` | `!Name` | `(.outputSelector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:37` | `CheckedFieldCopy` | data | yes | `outputWireName` | `outputWireName` | `!Text` | `(.outputWireName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:38` | `CheckedFieldCopy` | data | yes | `outputFieldType` | `outputFieldType` | `!ResolvedAggregateType` | `(.outputFieldType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:43` | `OutputObligationKey` | newtype | yes | `unOutputObligationKey` | `unOutputObligationKey` | `Text` | explicit `unOutputObligationKey` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:52` | `EventOutputMapping` | data | yes | `outputSourceCommand` | `sourceCommand` | `!Name` | `(.sourceCommand)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:53` | `EventOutputMapping` | data | yes | `outputFields` | `fields` | `![CheckedFieldCopy]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:56` | `EventOutputMapping` | data | yes | `outputObligation` | `obligation` | `!OutputObligationKey` | `(.obligation)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:64` | `EventOutputError` | data | yes | `declaredSourceCommand` | `declaredSourceCommand` | `!Name` | `(.declaredSourceCommand)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:65` | `EventOutputError` | data | yes | `consumingTransitionCommand` | `consumingTransitionCommand` | `!Name` | `(.consumingTransitionCommand)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/EventOutput.hs:66` | `EventOutputError` | data | yes | `emittedEventName` | `emittedEventName` | `!Name` | `(.emittedEventName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:45` | `BindingObligation` | data | yes | `obligationMappedName` | `mappedName` | `!Name` | `(.mappedName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:46` | `BindingObligation` | data | yes | `obligationPackage` | `package` | `!Text` | `(.package)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:47` | `BindingObligation` | data | yes | `obligationModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:48` | `BindingObligation` | data | yes | `obligationSymbol` | `symbol` | `!Text` | `(.symbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:49` | `BindingObligation` | data | yes | `obligationKind` | `kind` | `!BindingObligationKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:50` | `BindingObligation` | data | yes | `obligationSignature` | `signature` | `!Text` | `(.signature)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:51` | `BindingObligation` | data | yes | `obligationUseSites` | `useSites` | `![Text]` | `(.useSites)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:52` | `BindingObligation` | data | yes | `obligationBindingVersion` | `bindingVersion` | `!(Maybe Text)` | `(.bindingVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:53` | `BindingObligation` | data | yes | `obligationCanonicalType` | `canonicalType` | `!(Maybe Text)` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:54` | `BindingObligation` | data | yes | `obligationEqualityContract` | `equalityContract` | `!(Maybe Text)` | `(.equalityContract)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:55` | `BindingObligation` | data | yes | `obligationIdDomainContract` | `idDomainContract` | `!(Maybe Text)` | `(.idDomainContract)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:56` | `BindingObligation` | data | yes | `obligationCategory` | `category` | `!Text` | `(.category)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:61` | `BindingHole` | data | yes | `holeMappedName` | `mappedName` | `!Name` | `(.mappedName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:62` | `BindingHole` | data | yes | `holeModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:63` | `BindingHole` | data | yes | `holeSymbol` | `symbol` | `!Text` | `(.symbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:64` | `BindingHole` | data | yes | `holeKind` | `kind` | `!BindingObligationKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:65` | `BindingHole` | data | yes | `holePath` | `path` | `!(Maybe Text)` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ExplainBindings.hs:66` | `BindingHole` | data | yes | `holeSignature` | `signature` | `!Text` | `(.signature)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:45` | `ExpressionEnvironment` | data | no | `environmentSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:46` | `ExpressionEnvironment` | data | no | `environmentAggregate` | `aggregate` | `!Aggregate` | `(.aggregate)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:47` | `ExpressionEnvironment` | data | no | `environmentTransition` | `transition` | `!Transition` | `(.transition)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:48` | `ExpressionEnvironment` | data | no | `environmentSymbols` | `symbols` | `!AggregateSymbols` | `(.symbols)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:49` | `ExpressionEnvironment` | data | no | `environmentTypeGraph` | `typeGraph` | `!(Maybe TypeGraph)` | `(.typeGraph)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:88` | `ResolvedScalarProjection` | data | yes | `scalarProjectionOwner` | `owner` | `!MappedKey` | `(.owner)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:89` | `ResolvedScalarProjection` | data | yes | `scalarProjectionPointer` | `pointer` | `!Text` | `(.pointer)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:90` | `ResolvedScalarProjection` | data | yes | `scalarProjectionFields` | `fields` | `![Name]` | `(.fields)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:125` | `TypedScalarExpr` | data | yes | `typedScalarType` | `valueType` | `!ResolvedAggregateType` | `(.valueType)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:126` | `TypedScalarExpr` | data | yes | `typedScalarLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:127` | `TypedScalarExpr` | data | yes | `typedScalarNode` | `node` | `!TypedScalarNode` | `(.node)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:147` | `ExpressionDiagnostic` | data | yes | `expressionDiagnosticLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:148` | `ExpressionDiagnostic` | data | yes | `expressionDiagnosticCode` | `code` | `!ExpressionDiagnosticCode` | `(.code)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Expression.hs:149` | `ExpressionDiagnostic` | data | yes | `expressionDiagnosticMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/FieldIdentity.hs:18` | `ResolvedFieldIdentity` | data | no | `fieldDslName` | `dslName` | `!Name` | `(.dslName)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/FieldIdentity.hs:19` | `ResolvedFieldIdentity` | data | no | `fieldSelector` | `selector` | `!Text` | `(.selector)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/FieldIdentity.hs:20` | `ResolvedFieldIdentity` | data | no | `fieldWireKey` | `wireKey` | `!Text` | `(.wireKey)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/FieldIdentity.hs:21` | `ResolvedFieldIdentity` | data | no | `fieldLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:55` | `FrontendContext` | data | no | `source` | `source` | `!FilePath` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:56` | `FrontendContext` | data | no | `language` | `language` | `!SourceLanguage` | `(.language)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:57` | `FrontendContext` | data | no | `definition` | `definition` | `!LanguageDefinition` | `(.definition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:91` | `FrontendFailure` | data | no | `phase` | `phase` | `!FrontendPhase` | `(.phase)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:92` | `FrontendFailure` | data | no | `code` | `code` | `!FrontendErrorCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:93` | `FrontendFailure` | data | no | `span` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:94` | `FrontendFailure` | data | no | `message` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:95` | `FrontendFailure` | data | no | `expected` | `expected` | `![Text]` | `(.expected)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:96` | `FrontendFailure` | data | no | `supportedVersions` | `supportedVersions` | `![LanguageVersion]` | `(.supportedVersions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:97` | `FrontendFailure` | data | no | `compatibility` | `compatibility` | `!ParseFailure` | `(.compatibility)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:143` | `LoweringFailure` | data | no | `code` | `code` | `!LoweringFailureCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:144` | `LoweringFailure` | data | no | `span` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Frontend/Internal.hs:145` | `LoweringFailure` | data | no | `message` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:42` | `GoldenPayload` | data | yes | `goldenContext` | `context` | `!Text` | `(.context)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:43` | `GoldenPayload` | data | yes | `goldenAggregate` | `aggregate` | `!Text` | `(.aggregate)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:44` | `GoldenPayload` | data | yes | `goldenEvent` | `event` | `!Text` | `(.event)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:45` | `GoldenPayload` | data | yes | `goldenVersion` | `version` | `!Int` | `(.version)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:46` | `GoldenPayload` | data | yes | `goldenJson` | `json` | `!Text` | `(.json)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Goldens.hs:47` | `GoldenPayload` | data | yes | `goldenEvidence` | `evidence` | `!GoldenEvidence` | `(.evidence)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:188` | `Loc` | newtype | yes | `unLoc` | `unLoc` | `Int` | explicit `unLoc` positional function | rendered/canonical output | `deriving stock (Show)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:204` | `IdDecl` | data | yes | `idName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:205` | `IdDecl` | data | yes | `idPrefix` | `prefix` | `!Text` | `(.prefix)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:206` | `IdDecl` | data | yes | `idBinding` | `binding` | `!(Maybe NominalBindingDecl)` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:207` | `IdDecl` | data | yes | `idLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:214` | `EnumDecl` | data | yes | `enumName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:215` | `EnumDecl` | data | yes | `enumCtors` | `ctors` | `![(Name, Text)]` | `(.ctors)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:216` | `EnumDecl` | data | yes | `enumBinding` | `binding` | `!(Maybe NominalBindingDecl)` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:217` | `EnumDecl` | data | yes | `enumLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:225` | `RuleDecl` | data | yes | `ruleName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:226` | `RuleDecl` | data | yes | `ruleDomain` | `domain` | `!Name` | `(.domain)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:227` | `RuleDecl` | data | yes | `ruleCodomain` | `codomain` | `!Name` | `(.codomain)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:228` | `RuleDecl` | data | yes | `ruleCases` | `cases` | `![(Name, Expr)]` | `(.cases)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:229` | `RuleDecl` | data | yes | `ruleLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:269` | `WireField` | data | yes | `wfHaskell` | `haskell` | `!Name` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:270` | `WireField` | data | yes | `wfKey` | `key` | `!Text` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:271` | `WireField` | data | yes | `wfType` | `valueType` | `!TypeExpr` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:272` | `WireField` | data | yes | `wfPresence` | `presence` | `!Presence` | `(.presence)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:273` | `WireField` | data | yes | `wfOnMissing` | `onMissing` | `!(Maybe OnMissing)` | `(.onMissing)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:274` | `WireField` | data | yes | `wfLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:282` | `UnionEncoding` | data | yes | `ueTagField` | `tagField` | `!Text` | `(.tagField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:283` | `UnionEncoding` | data | yes | `ueContentsField` | `contentsField` | `!Text` | `(.contentsField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:284` | `UnionEncoding` | data | yes | `ueUnknownFields` | `unknownFields` | `!UnknownFields` | `(.unknownFields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:289` | `WireEnum` | data | yes | `weCtor` | `ctor` | `!Name` | `(.ctor)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:290` | `WireEnum` | data | yes | `weTag` | `tag` | `!Text` | `(.tag)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:291` | `WireEnum` | data | yes | `weLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:296` | `WireArm` | data | yes | `waCtor` | `ctor` | `!Name` | `(.ctor)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:297` | `WireArm` | data | yes | `waTag` | `tag` | `!Text` | `(.tag)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:298` | `WireArm` | data | yes | `waPayload` | `payload` | `!(Maybe TypeExpr)` | `(.payload)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:299` | `WireArm` | data | yes | `waLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:310` | `HaskellSource` | data | yes | `hsPackage` | `package` | `!Text` | `(.package)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:311` | `HaskellSource` | data | yes | `hsModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:312` | `HaskellSource` | data | yes | `hsType` | `valueType` | `!Name` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:321` | `NominalBindingDecl` | data | yes | `nominalHaskell` | `haskell` | `!(Maybe HaskellSource)` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:322` | `NominalBindingDecl` | data | yes | `nominalBinding` | `binding` | `!(Maybe Text)` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:323` | `NominalBindingDecl` | data | yes | `nominalBindingVersion` | `bindingVersion` | `!(Maybe Text)` | `(.bindingVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:324` | `NominalBindingDecl` | data | yes | `nominalCanonicalType` | `canonicalType` | `!(Maybe Text)` | `(.canonicalType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:325` | `NominalBindingDecl` | data | yes | `nominalFixtures` | `fixtures` | `!(Maybe Text)` | `(.fixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:326` | `NominalBindingDecl` | data | yes | `nominalInitial` | `initial` | `!(Maybe Text)` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:327` | `NominalBindingDecl` | data | yes | `nominalLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:336` | `NominalScalarDecl` | data | yes | `nominalScalarName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:337` | `NominalScalarDecl` | data | yes | `nominalScalarRepresentation` | `representation` | `!Name` | `(.representation)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:338` | `NominalScalarDecl` | data | yes | `nominalScalarBinding` | `binding` | `!NominalBindingDecl` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:339` | `NominalScalarDecl` | data | yes | `nominalScalarLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:345` | `MappedDecl` | data | yes | `msName` | `msName` | `!Name` | `(.msName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:346` | `MappedDecl` | data | yes | `msHaskell` | `msHaskell` | `!(Maybe HaskellSource)` | `(.msHaskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:347` | `MappedDecl` | data | yes | `msBinding` | `msBinding` | `!(Maybe Text)` | `(.msBinding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:348` | `MappedDecl` | data | yes | `msBindingVersion` | `msBindingVersion` | `!(Maybe Text)` | `(.msBindingVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:349` | `MappedDecl` | data | yes | `msCanonical` | `msCanonical` | `!(Maybe Text)` | `(.msCanonical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:350` | `MappedDecl` | data | yes | `msFixtures` | `msFixtures` | `!(Maybe Text)` | `(.msFixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:351` | `MappedDecl` | data | yes | `msInitial` | `msInitial` | `!(Maybe Text)` | `(.msInitial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:352` | `MappedDecl` | data | yes | `msShape` | `msShape` | `!MappedShape` | `(.msShape)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:353` | `MappedDecl` | data | yes | `msLoc` | `msLoc` | `!Loc` | `(.msLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:356` | `MappedDecl` | data | yes | `moName` | `moName` | `!Name` | `(.moName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:357` | `MappedDecl` | data | yes | `moHaskell` | `moHaskell` | `!(Maybe HaskellSource)` | `(.moHaskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:358` | `MappedDecl` | data | yes | `moCodecId` | `moCodecId` | `!(Maybe Text)` | `(.moCodecId)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:359` | `MappedDecl` | data | yes | `moCodecVersion` | `moCodecVersion` | `!(Maybe Text)` | `(.moCodecVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:360` | `MappedDecl` | data | yes | `moFixtures` | `moFixtures` | `!(Maybe Text)` | `(.moFixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:361` | `MappedDecl` | data | yes | `moInitial` | `moInitial` | `!(Maybe Text)` | `(.moInitial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:362` | `MappedDecl` | data | yes | `moLoc` | `moLoc` | `!Loc` | `(.moLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:370` | `Mapping` | data | yes | `mapPairs` | `pairs` | `![(Name, Name)]` | `(.pairs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:371` | `Mapping` | data | yes | `mapPartial` | `partial` | `!Bool` | `(.partial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:481` | `RegDecl` | data | yes | `regName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:482` | `RegDecl` | data | yes | `regType` | `valueType` | `!TypeExpr` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:483` | `RegDecl` | data | yes | `regInitial` | `initial` | `!RegInitial` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:484` | `RegDecl` | data | yes | `regLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:492` | `StateDecl` | data | yes | `stName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:493` | `StateDecl` | data | yes | `stTerminal` | `terminal` | `!Bool` | `(.terminal)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:494` | `StateDecl` | data | yes | `stLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:505` | `AggregateField` | data | yes | `aggregateFieldName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:506` | `AggregateField` | data | yes | `aggregateFieldSelector` | `selector` | `!(Maybe Name)` | `(.selector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:507` | `AggregateField` | data | yes | `aggregateFieldWireKey` | `wireKey` | `!(Maybe Text)` | `(.wireKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:508` | `AggregateField` | data | yes | `aggregateFieldType` | `valueType` | `!(Maybe TypeExpr)` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:509` | `AggregateField` | data | yes | `aggregateFieldLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:516` | `Field` | data | yes | `fieldName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:517` | `Field` | data | yes | `fieldType` | `valueType` | `!(Maybe Name)` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:523` | `Command` | data | yes | `cmdName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:524` | `Command` | data | yes | `cmdFields` | `fields` | `![AggregateField]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:525` | `Command` | data | yes | `cmdLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:535` | `Event` | data | yes | `evName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:536` | `Event` | data | yes | `evBody` | `body` | `!EventBody` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:538` | `Event` | data | yes | `evVersion` | `version` | `!Int` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:541` | `Event` | data | yes | `evUpcastFrom` | `upcastFrom` | `!(Maybe (Int, Hole))` | `(.upcastFrom)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:546` | `Event` | data | yes | `evRetiring` | `retiring` | `!Bool` | `(.retiring)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:550` | `Event` | data | yes | `evDeprecated` | `deprecated` | `!Bool` | `(.deprecated)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:551` | `Event` | data | yes | `evLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:569` | `DomainOutcomeTypes` | data | yes | `rejectionType` | `rejectionType` | `!Name` | `(.rejectionType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:570` | `DomainOutcomeTypes` | data | yes | `noOpType` | `noOpType` | `!Name` | `(.noOpType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:571` | `DomainOutcomeTypes` | data | yes | `outcomeTypesLoc` | `outcomeTypesLoc` | `!Loc` | `(.outcomeTypesLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:591` | `Transition` | data | yes | `tSource` | `source` | `!Name` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:592` | `Transition` | data | yes | `tCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:593` | `Transition` | data | yes | `tImplementation` | `implementation` | `!TransitionImplementation` | `(.implementation)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:594` | `Transition` | data | yes | `tGuard` | `guard` | `!(Maybe Expr)` | `(.guard)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:595` | `Transition` | data | yes | `tWrites` | `writes` | `![(Name, Expr)]` | `(.writes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:596` | `Transition` | data | yes | `tEmits` | `emits` | `![Name]` | `(.emits)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:597` | `Transition` | data | yes | `tOutcome` | `outcome` | `!(Maybe TransitionOutcome)` | `(.outcome)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:600` | `Transition` | data | yes | `tOutcomeDuplicateLocs` | `outcomeDuplicateLocs` | `![Loc]` | `(.outcomeDuplicateLocs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:601` | `Transition` | data | yes | `tGoto` | `goto` | `!Name` | `(.goto)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:602` | `Transition` | data | yes | `tMode` | `mode` | `!TransitionMode` | `(.mode)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:603` | `Transition` | data | yes | `tLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:631` | `WireSpec` | data | yes | `wireKind` | `kind` | `!Text` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:632` | `WireSpec` | data | yes | `wireFields` | `fields` | `!Text` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:633` | `WireSpec` | data | yes | `wireSchemaVersion` | `schemaVersion` | `!Int` | `(.schemaVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:640` | `ProjectionSpec` | data | yes | `projTable` | `table` | `!Name` | `(.table)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:641` | `ProjectionSpec` | data | yes | `projConsistency` | `consistency` | `!(Maybe Consistency)` | `(.consistency)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:642` | `ProjectionSpec` | data | yes | `projKey` | `key` | `!Name` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:643` | `ProjectionSpec` | data | yes | `projStatusMap` | `statusMap` | `!(Maybe Mapping)` | `(.statusMap)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:644` | `ProjectionSpec` | data | yes | `projLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:657` | `SnapshotSpec` | data | yes | `snapPolicy` | `policy` | `!SnapPolicy` | `(.policy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:658` | `SnapshotSpec` | data | yes | `snapCodecVersion` | `codecVersion` | `!Int` | `(.codecVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:659` | `SnapshotSpec` | data | yes | `snapShapeHash` | `shapeHash` | `!Text` | `(.shapeHash)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:660` | `SnapshotSpec` | data | yes | `snapLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:667` | `Aggregate` | data | yes | `aggName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:668` | `Aggregate` | data | yes | `aggRegs` | `regs` | `![RegDecl]` | `(.regs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:669` | `Aggregate` | data | yes | `aggStates` | `states` | `![StateDecl]` | `(.states)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:670` | `Aggregate` | data | yes | `aggCommands` | `commands` | `![Command]` | `(.commands)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:671` | `Aggregate` | data | yes | `aggEvents` | `events` | `![Event]` | `(.events)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:672` | `Aggregate` | data | yes | `aggTransitions` | `transitions` | `![Transition]` | `(.transitions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:673` | `Aggregate` | data | yes | `aggDomainOutcomeTypes` | `domainOutcomeTypes` | `!(Maybe DomainOutcomeTypes)` | `(.domainOutcomeTypes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:676` | `Aggregate` | data | yes | `aggDomainOutcomeDuplicateLocs` | `domainOutcomeDuplicateLocs` | `![Loc]` | `(.domainOutcomeDuplicateLocs)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:677` | `Aggregate` | data | yes | `aggWire` | `wire` | `!(Maybe WireSpec)` | `(.wire)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:678` | `Aggregate` | data | yes | `aggProjection` | `projection` | `!(Maybe ProjectionSpec)` | `(.projection)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:679` | `Aggregate` | data | yes | `aggSnapshot` | `snapshot` | `!(Maybe SnapshotSpec)` | `(.snapshot)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:680` | `Aggregate` | data | yes | `aggLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:690` | `FieldBinding` | data | yes | `fbName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:691` | `FieldBinding` | data | yes | `fbValue` | `value` | `!(Maybe Text)` | `(.value)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:698` | `InputDecl` | data | yes | `inName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:699` | `InputDecl` | data | yes | `inFields` | `fields` | `![Field]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:700` | `InputDecl` | data | yes | `inType` | `valueType` | `!(Maybe TypeExpr)` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:701` | `InputDecl` | data | yes | `inLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:708` | `CorrelateDecl` | data | yes | `corrField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:709` | `CorrelateDecl` | data | yes | `corrVia` | `via` | `!Name` | `(.via)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:717` | `SagaRef` | data | yes | `sagaAgg` | `agg` | `!Name` | `(.agg)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:718` | `SagaRef` | data | yes | `sagaCategory` | `category` | `!Text` | `(.category)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:729` | `DispatchDisposition` | data | yes | `onAppended` | `onAppended` | `!Disp` | `(.onAppended)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:730` | `DispatchDisposition` | data | yes | `onDuplicate` | `onDuplicate` | `!Disp` | `(.onDuplicate)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:731` | `DispatchDisposition` | data | yes | `onFailed` | `onFailed` | `!Disp` | `(.onFailed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:737` | `AdvanceNode` | data | yes | `advCommand` | `advCommand` | `!Name` | `(.advCommand)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:738` | `AdvanceNode` | data | yes | `advFields` | `advFields` | `![FieldBinding]` | `(.advFields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:744` | `DispatchNode` | data | yes | `dispTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:745` | `DispatchNode` | data | yes | `dispKey` | `key` | `!Text` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:746` | `DispatchNode` | data | yes | `dispCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:747` | `DispatchNode` | data | yes | `dispFields` | `fields` | `![FieldBinding]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:748` | `DispatchNode` | data | yes | `disposition` | `osition` | `!DispatchDisposition` | `(.osition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:749` | `DispatchNode` | data | yes | `dispLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:756` | `HandleNode` | data | yes | `hOn` | `on` | `!Name` | `(.on)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:757` | `HandleNode` | data | yes | `hAdvance` | `advance` | `!AdvanceNode` | `(.advance)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:758` | `HandleNode` | data | yes | `hDispatch` | `dispatch` | `![DispatchNode]` | `(.dispatch)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:759` | `HandleNode` | data | yes | `hSchedule` | `schedule` | `!Name` | `(.schedule)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:765` | `IdExpr` | data | yes | `ideStrategy` | `strategy` | `!IdStrategy` | `(.strategy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:766` | `IdExpr` | data | yes | `idePrefix` | `prefix` | `!Text` | `(.prefix)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:767` | `IdExpr` | data | yes | `ideField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:778` | `FireAtExpr` | data | yes | `faField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:779` | `FireAtExpr` | data | yes | `faWindow` | `window` | `!Text` | `(.window)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:789` | `FireDisposition` | data | yes | `onOk` | `onOk` | `!FireOutcome` | `(.onOk)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:790` | `FireDisposition` | data | yes | `onReject` | `onReject` | `!FireOutcome` | `(.onReject)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:791` | `FireDisposition` | data | yes | `onAmbiguous` | `onAmbiguous` | `!FireOutcome` | `(.onAmbiguous)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:792` | `FireDisposition` | data | yes | `onError` | `onError` | `!FireOutcome` | `(.onError)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:793` | `FireDisposition` | data | yes | `notMine` | `notMine` | `!FireOutcome` | `(.notMine)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:799` | `FireNode` | data | yes | `fireTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:800` | `FireNode` | data | yes | `fireKey` | `key` | `!Text` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:801` | `FireNode` | data | yes | `fireCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:802` | `FireNode` | data | yes | `fireFields` | `fields` | `![FieldBinding]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:803` | `FireNode` | data | yes | `fireFiredEventId` | `firedEventId` | `!IdExpr` | `(.firedEventId)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:804` | `FireNode` | data | yes | `fireDisposition` | `disposition` | `!FireDisposition` | `(.disposition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:810` | `TimerNode` | data | yes | `tmName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:811` | `TimerNode` | data | yes | `tmId` | `id` | `!IdExpr` | `(.id)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:812` | `TimerNode` | data | yes | `tmFireAt` | `fireAt` | `!FireAtExpr` | `(.fireAt)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:813` | `TimerNode` | data | yes | `tmPayload` | `payload` | `![FieldBinding]` | `(.payload)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:814` | `TimerNode` | data | yes | `tmFire` | `fire` | `!FireNode` | `(.fire)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:815` | `TimerNode` | data | yes | `tmDecodeUnknown` | `decodeUnknown` | `!Name` | `(.decodeUnknown)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:816` | `TimerNode` | data | yes | `tmMaxAttempts` | `maxAttempts` | `!Int` | `(.maxAttempts)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:817` | `TimerNode` | data | yes | `tmDeadLetter` | `deadLetter` | `!Text` | `(.deadLetter)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:818` | `TimerNode` | data | yes | `tmLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:830` | `ProcessNode` | data | yes | `procId` | `id` | `!Name` | `(.id)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:832` | `ProcessNode` | data | yes | `procName` | `name` | `!Text` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:833` | `ProcessNode` | data | yes | `procInput` | `input` | `!InputDecl` | `(.input)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:834` | `ProcessNode` | data | yes | `procCorrelate` | `correlate` | `!CorrelateDecl` | `(.correlate)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:835` | `ProcessNode` | data | yes | `procSaga` | `saga` | `!SagaRef` | `(.saga)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:836` | `ProcessNode` | data | yes | `procTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:837` | `ProcessNode` | data | yes | `procProjections` | `projections` | `![Name]` | `(.projections)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:838` | `ProcessNode` | data | yes | `procHandle` | `handle` | `!HandleNode` | `(.handle)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:839` | `ProcessNode` | data | yes | `procRejected` | `rejected` | `!PolicyChoice` | `(.rejected)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:840` | `ProcessNode` | data | yes | `procPoison` | `poison` | `!PolicyChoice` | `(.poison)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:841` | `ProcessNode` | data | yes | `procTimer` | `timer` | `!TimerNode` | `(.timer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:842` | `ProcessNode` | data | yes | `procLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:859` | `RouterSelectionDecl` | data | yes | `rsIdentity` | `identity` | `!Text` | `(.identity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:860` | `RouterSelectionDecl` | data | yes | `rsIdentityLoc` | `identityLoc` | `!Loc` | `(.identityLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:861` | `RouterSelectionDecl` | data | yes | `rsVersion` | `version` | `!Natural` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:862` | `RouterSelectionDecl` | data | yes | `rsVersionLoc` | `versionLoc` | `!Loc` | `(.versionLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:863` | `RouterSelectionDecl` | data | yes | `rsQuery` | `query` | `!Name` | `(.query)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:864` | `RouterSelectionDecl` | data | yes | `rsQueryLoc` | `queryLoc` | `!Loc` | `(.queryLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:865` | `RouterSelectionDecl` | data | yes | `rsQueryInput` | `queryInput` | `!Name` | `(.queryInput)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:866` | `RouterSelectionDecl` | data | yes | `rsQueryInputLoc` | `queryInputLoc` | `!Loc` | `(.queryInputLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:867` | `RouterSelectionDecl` | data | yes | `rsPredicate` | `predicate` | `!Expr` | `(.predicate)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:868` | `RouterSelectionDecl` | data | yes | `rsRecipient` | `recipient` | `!Expr` | `(.recipient)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:869` | `RouterSelectionDecl` | data | yes | `rsLimit` | `limit` | `!(Maybe (Natural, Loc))` | `(.limit)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:870` | `RouterSelectionDecl` | data | yes | `rsOrder` | `order` | `!Name` | `(.order)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:871` | `RouterSelectionDecl` | data | yes | `rsOrderLoc` | `orderLoc` | `!Loc` | `(.orderLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:872` | `RouterSelectionDecl` | data | yes | `rsDedupe` | `dedupe` | `!Name` | `(.dedupe)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:873` | `RouterSelectionDecl` | data | yes | `rsDedupeLoc` | `dedupeLoc` | `!Loc` | `(.dedupeLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:874` | `RouterSelectionDecl` | data | yes | `rsEmptyPolicy` | `emptyPolicy` | `!SelectionDispositionSyntax` | `(.emptyPolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:875` | `RouterSelectionDecl` | data | yes | `rsEmptyPolicyLoc` | `emptyPolicyLoc` | `!Loc` | `(.emptyPolicyLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:876` | `RouterSelectionDecl` | data | yes | `rsFailurePolicy` | `failurePolicy` | `!SelectionDispositionSyntax` | `(.failurePolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:877` | `RouterSelectionDecl` | data | yes | `rsFailurePolicyLoc` | `failurePolicyLoc` | `!Loc` | `(.failurePolicyLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:878` | `RouterSelectionDecl` | data | yes | `rsRedelivery` | `redelivery` | `!Name` | `(.redelivery)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:879` | `RouterSelectionDecl` | data | yes | `rsRedeliveryLoc` | `redeliveryLoc` | `!Loc` | `(.redeliveryLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:880` | `RouterSelectionDecl` | data | yes | `rsPartial` | `partial` | `!Name` | `(.partial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:881` | `RouterSelectionDecl` | data | yes | `rsPartialLoc` | `partialLoc` | `!Loc` | `(.partialLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:882` | `RouterSelectionDecl` | data | yes | `rsLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:893` | `ResolveDecl` | data | yes | `rvSource` | `source` | `!ResolveSource` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:894` | `ResolveDecl` | data | yes | `rvRow` | `row` | `![Name]` | `(.row)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:895` | `ResolveDecl` | data | yes | `rvLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:900` | `RouterDispatchNode` | data | yes | `rdCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:901` | `RouterDispatchNode` | data | yes | `rdFields` | `fields` | `![FieldBinding]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:902` | `RouterDispatchNode` | data | yes | `rdDisposition` | `disposition` | `!DispatchDisposition` | `(.disposition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:903` | `RouterDispatchNode` | data | yes | `rdLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:911` | `RouterNode` | data | yes | `rtId` | `id` | `!Name` | `(.id)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:912` | `RouterNode` | data | yes | `rtName` | `name` | `!Text` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:913` | `RouterNode` | data | yes | `rtInput` | `input` | `!InputDecl` | `(.input)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:914` | `RouterNode` | data | yes | `rtKey` | `key` | `!CorrelateDecl` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:915` | `RouterNode` | data | yes | `rtResolve` | `resolve` | `!ResolveDecl` | `(.resolve)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:916` | `RouterNode` | data | yes | `rtTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:917` | `RouterNode` | data | yes | `rtProjections` | `projections` | `![Name]` | `(.projections)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:918` | `RouterNode` | data | yes | `rtDispatch` | `dispatch` | `!RouterDispatchNode` | `(.dispatch)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:919` | `RouterNode` | data | yes | `rtRejected` | `rejected` | `!PolicyChoice` | `(.rejected)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:920` | `RouterNode` | data | yes | `rtPoison` | `poison` | `!PolicyChoice` | `(.poison)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:921` | `RouterNode` | data | yes | `rtLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:932` | `ContractField` | data | yes | `cfName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:933` | `ContractField` | data | yes | `cfSelector` | `selector` | `!(Maybe Name)` | `(.selector)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:934` | `ContractField` | data | yes | `cfWireKey` | `wireKey` | `!(Maybe Text)` | `(.wireKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:935` | `ContractField` | data | yes | `cfType` | `valueType` | `!ContractType` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:936` | `ContractField` | data | yes | `cfLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:942` | `ContractEvent` | data | yes | `ceName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:943` | `ContractEvent` | data | yes | `ceTopic` | `topic` | `!Name` | `(.topic)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:944` | `ContractEvent` | data | yes | `ceFields` | `fields` | `![ContractField]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:952` | `ContractNode` | data | yes | `ctrName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:953` | `ContractNode` | data | yes | `ctrSchemaVersion` | `schemaVersion` | `!Int` | `(.schemaVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:954` | `ContractNode` | data | yes | `ctrDiscriminator` | `discriminator` | `!Name` | `(.discriminator)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:956` | `ContractNode` | data | yes | `ctrTopics` | `topics` | `![(Name, Text)]` | `(.topics)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:957` | `ContractNode` | data | yes | `ctrEvents` | `events` | `![ContractEvent]` | `(.events)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:958` | `ContractNode` | data | yes | `ctrLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:974` | `BindRow` | data | yes | `brField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:975` | `BindRow` | data | yes | `brSource` | `source` | `!WireSource` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:976` | `BindRow` | data | yes | `brRequired` | `required` | `!Bool` | `(.required)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:977` | `BindRow` | data | yes | `brCrossCheck` | `crossCheck` | `!Bool` | `(.crossCheck)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:993` | `DispositionRow` | data | yes | `drOutcome` | `outcome` | `!Name` | `(.outcome)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:994` | `DispositionRow` | data | yes | `drAction` | `action` | `!InboxAction` | `(.action)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:995` | `DispositionRow` | data | yes | `drLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1002` | `DecodeSpec` | data | yes | `decEnvelope` | `envelope` | `!Text` | `(.envelope)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1003` | `DecodeSpec` | data | yes | `decBodyStrict` | `bodyStrict` | `!Bool` | `(.bodyStrict)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1004` | `DecodeSpec` | data | yes | `decBodySchemaVersion` | `bodySchemaVersion` | `!Int` | `(.bodySchemaVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1016` | `IntakeNode` | data | yes | `inkName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1017` | `IntakeNode` | data | yes | `inkContract` | `contract` | `!Name` | `(.contract)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1018` | `IntakeNode` | data | yes | `inkTopic` | `topic` | `!Name` | `(.topic)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1019` | `IntakeNode` | data | yes | `inkAccept` | `accept` | `![Name]` | `(.accept)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1020` | `IntakeNode` | data | yes | `inkBinds` | `binds` | `![BindRow]` | `(.binds)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1021` | `IntakeNode` | data | yes | `inkDedupeKey` | `dedupeKey` | `!Name` | `(.dedupeKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1022` | `IntakeNode` | data | yes | `inkDedupePolicy` | `dedupePolicy` | `!Name` | `(.dedupePolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1023` | `IntakeNode` | data | yes | `inkPersist` | `persist` | `!InkPersist` | `(.persist)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1024` | `IntakeNode` | data | yes | `inkDecode` | `decode` | `!DecodeSpec` | `(.decode)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1025` | `IntakeNode` | data | yes | `inkDisposition` | `disposition` | `![DispositionRow]` | `(.disposition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1026` | `IntakeNode` | data | yes | `inkLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1033` | `DeriveSpec` | newtype | yes | `dsPrefix` | `dsPrefix` | `Maybe Text` | `(.dsPrefix)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1038` | `EmitMapRow` | data | yes | `emrValue` | `value` | `!Text` | `(.value)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1039` | `EmitMapRow` | data | yes | `emrEvent` | `event` | `!Name` | `(.event)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1040` | `EmitMapRow` | data | yes | `emrLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1047` | `EmitNode` | data | yes | `emName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1048` | `EmitNode` | data | yes | `emContract` | `contract` | `!Name` | `(.contract)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1049` | `EmitNode` | data | yes | `emTopic` | `topic` | `!Name` | `(.topic)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1050` | `EmitNode` | data | yes | `emSource` | `source` | `!Text` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1051` | `EmitNode` | data | yes | `emKey` | `key` | `!Name` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1052` | `EmitNode` | data | yes | `emDiscriminant` | `discriminant` | `!Name` | `(.discriminant)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1053` | `EmitNode` | data | yes | `emMap` | `map` | `![EmitMapRow]` | `(.map)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1055` | `EmitNode` | data | yes | `emSkip` | `skip` | `!Bool` | `(.skip)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1056` | `EmitNode` | data | yes | `emMessageId` | `messageId` | `!DeriveSpec` | `(.messageId)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1057` | `EmitNode` | data | yes | `emIdempotencyKey` | `idempotencyKey` | `!DeriveSpec` | `(.idempotencyKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1058` | `EmitNode` | data | yes | `emLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1064` | `BackoffSpec` | data | yes | `boKind` | `kind` | `!Name` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1065` | `BackoffSpec` | data | yes | `boWindow` | `window` | `!Text` | `(.window)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1066` | `BackoffSpec` | data | yes | `boMax` | `max` | `!(Maybe Text)` | `(.max)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1067` | `BackoffSpec` | data | yes | `boMultiplier` | `multiplier` | `!(Maybe Text)` | `(.multiplier)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1073` | `PublisherNode` | data | yes | `pubName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1074` | `PublisherNode` | data | yes | `pubEmit` | `emit` | `!Name` | `(.emit)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1075` | `PublisherNode` | data | yes | `pubOrdering` | `ordering` | `!Name` | `(.ordering)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1076` | `PublisherNode` | data | yes | `pubMaxAttempts` | `maxAttempts` | `!Int` | `(.maxAttempts)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1077` | `PublisherNode` | data | yes | `pubBackoff` | `backoff` | `!BackoffSpec` | `(.backoff)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1079` | `PublisherNode` | data | yes | `pubOutboxField` | `outboxField` | `!Name` | `(.outboxField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1080` | `PublisherNode` | data | yes | `pubLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1110` | `WqField` | data | yes | `wqfName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1111` | `WqField` | data | yes | `wqfWire` | `wire` | `!Text` | `(.wire)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1112` | `WqField` | data | yes | `wqfType` | `valueType` | `!QueuePayloadType` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1113` | `WqField` | data | yes | `wqfLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1120` | `WqDispRow` | data | yes | `wqdOutcome` | `outcome` | `!Name` | `(.outcome)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1121` | `WqDispRow` | data | yes | `wqdAction` | `action` | `!InboxAction` | `(.action)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1122` | `WqDispRow` | data | yes | `wqdLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1132` | `WqGroupKey` | data | yes | `gkField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1133` | `WqGroupKey` | data | yes | `gkVia` | `via` | `!Name` | `(.via)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1134` | `WqGroupKey` | data | yes | `gkFixture` | `fixture` | `!(Maybe Text)` | `(.fixture)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1149` | `WorkqueueNode` | data | yes | `wqName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1150` | `WorkqueueNode` | data | yes | `wqLogical` | `logical` | `!Text` | `(.logical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1151` | `WorkqueueNode` | data | yes | `wqPhysical` | `physical` | `!Text` | `(.physical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1152` | `WorkqueueNode` | data | yes | `wqDlq` | `dlq` | `!Text` | `(.dlq)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1153` | `WorkqueueNode` | data | yes | `wqTable` | `table` | `!Text` | `(.table)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1154` | `WorkqueueNode` | data | yes | `wqOrdering` | `ordering` | `!WqOrdering` | `(.ordering)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1155` | `WorkqueueNode` | data | yes | `wqGroupKey` | `groupKey` | `!(Maybe WqGroupKey)` | `(.groupKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1156` | `WorkqueueNode` | data | yes | `wqProvision` | `provision` | `!WqProvision` | `(.provision)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1157` | `WorkqueueNode` | data | yes | `wqPayloadName` | `payloadName` | `!Name` | `(.payloadName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1158` | `WorkqueueNode` | data | yes | `wqPayload` | `payload` | `![WqField]` | `(.payload)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1159` | `WorkqueueNode` | data | yes | `wqMaxRetries` | `maxRetries` | `!Int` | `(.maxRetries)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1160` | `WorkqueueNode` | data | yes | `wqDelay` | `delay` | `!Text` | `(.delay)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1161` | `WorkqueueNode` | data | yes | `wqDlqOn` | `dlqOn` | `!Bool` | `(.dlqOn)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1162` | `WorkqueueNode` | data | yes | `wqDisposition` | `disposition` | `![WqDispRow]` | `(.disposition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1163` | `WorkqueueNode` | data | yes | `wqLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1170` | `PgmqDispatchNode` | data | yes | `pdName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1171` | `PgmqDispatchNode` | data | yes | `pdSourceReadModel` | `sourceReadModel` | `!Name` | `(.sourceReadModel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1172` | `PgmqDispatchNode` | data | yes | `pdSourceKey` | `sourceKey` | `!Name` | `(.sourceKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1173` | `PgmqDispatchNode` | data | yes | `pdFanoutBody` | `fanoutBody` | `!Name` | `(.fanoutBody)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1174` | `PgmqDispatchNode` | data | yes | `pdDedupKey` | `dedupKey` | `!Name` | `(.dedupKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1175` | `PgmqDispatchNode` | data | yes | `pdDedupReadModel` | `dedupReadModel` | `!Name` | `(.dedupReadModel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1176` | `PgmqDispatchNode` | data | yes | `pdDedupReadModelField` | `dedupReadModelField` | `!Text` | `(.dedupReadModelField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1177` | `PgmqDispatchNode` | data | yes | `pdDedupQueue` | `dedupQueue` | `!Name` | `(.dedupQueue)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1178` | `PgmqDispatchNode` | data | yes | `pdDedupQueueField` | `dedupQueueField` | `!Text` | `(.dedupQueueField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1179` | `PgmqDispatchNode` | data | yes | `pdEnqueueTo` | `enqueueTo` | `!Name` | `(.enqueueTo)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1180` | `PgmqDispatchNode` | data | yes | `pdLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1188` | `RmColumn` | data | yes | `rmcName` | `rmcName` | `!Text` | `(.rmcName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1189` | `RmColumn` | data | yes | `rmcType` | `rmcType` | `!Text` | `(.rmcType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1190` | `RmColumn` | data | yes | `rmcRequired` | `rmcRequired` | `!Bool` | `(.rmcRequired)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1219` | `ReadModelSupply` | data | yes | `legacyConsistency` | `legacyConsistency` | `!Consistency` | `(.legacyConsistency)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1220` | `ReadModelSupply` | data | yes | `legacyScope` | `legacyScope` | `!(Maybe RmScope)` | `(.legacyScope)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1221` | `ReadModelSupply` | data | yes | `legacyFeed` | `legacyFeed` | `!RmFeed` | `(.legacyFeed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1222` | `ReadModelSupply` | data | yes | `legacySubscription` | `legacySubscription` | `!(Maybe Text)` | `(.legacySubscription)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1230` | `ReadModelQueryTypes` | data | yes | `input` | `input` | `!TypeExpr` | `(.input)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1231` | `ReadModelQueryTypes` | data | yes | `result` | `result` | `!TypeExpr` | `(.result)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1232` | `ReadModelQueryTypes` | data | yes | `inputLoc` | `inputLoc` | `!Loc` | `(.inputLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1233` | `ReadModelQueryTypes` | data | yes | `resultLoc` | `resultLoc` | `!Loc` | `(.resultLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1240` | `ReadModelNode` | data | yes | `rmName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1241` | `ReadModelNode` | data | yes | `rmTable` | `table` | `!Text` | `(.table)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1242` | `ReadModelNode` | data | yes | `rmSchema` | `schema` | `!Text` | `(.schema)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1243` | `ReadModelNode` | data | yes | `rmColumns` | `columns` | `![RmColumn]` | `(.columns)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1244` | `ReadModelNode` | data | yes | `rmVersion` | `version` | `!Int` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1245` | `ReadModelNode` | data | yes | `rmShape` | `shape` | `!Text` | `(.shape)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1246` | `ReadModelNode` | data | yes | `rmFreshness` | `freshness` | `!QueryFreshnessNode` | `(.freshness)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1247` | `ReadModelNode` | data | yes | `rmSupply` | `supply` | `!ReadModelSupply` | `(.supply)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1248` | `ReadModelNode` | data | yes | `rmGroup` | `group` | `!(Maybe Name)` | `(.group)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1249` | `ReadModelNode` | data | yes | `rmObservedTargets` | `observedTargets` | `![Name]` | `(.observedTargets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1250` | `ReadModelNode` | data | yes | `rmBackingTarget` | `backingTarget` | `!(Maybe Name)` | `(.backingTarget)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1251` | `ReadModelNode` | data | yes | `queryTypes` | `queryTypes` | `!(Maybe ReadModelQueryTypes)` | `(.queryTypes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1252` | `ReadModelNode` | data | yes | `rmLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1283` | `ProjectionTargetNode` | data | yes | `ptName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1284` | `ProjectionTargetNode` | data | yes | `ptSchema` | `schema` | `!Text` | `(.schema)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1285` | `ProjectionTargetNode` | data | yes | `ptTable` | `table` | `!Text` | `(.table)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1286` | `ProjectionTargetNode` | data | yes | `ptReset` | `reset` | `!TargetResetPolicy` | `(.reset)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1287` | `ProjectionTargetNode` | data | yes | `ptDependsOn` | `dependsOn` | `![Name]` | `(.dependsOn)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1288` | `ProjectionTargetNode` | data | yes | `ptLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1294` | `RebuildGroupNode` | data | yes | `rgName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1295` | `RebuildGroupNode` | data | yes | `rgTargets` | `targets` | `![Name]` | `(.targets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1296` | `RebuildGroupNode` | data | yes | `rgOrder` | `order` | `![Name]` | `(.order)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1297` | `RebuildGroupNode` | data | yes | `rgLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1308` | `PromotionObjectNode` | data | yes | `rpoKind` | `kind` | `!PromotionObjectKindNode` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1309` | `PromotionObjectNode` | data | yes | `rpoGenerationName` | `generationName` | `!Text` | `(.generationName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1310` | `PromotionObjectNode` | data | yes | `rpoCanonicalName` | `canonicalName` | `!Text` | `(.canonicalName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1317` | `RevisionTargetNode` | data | yes | `prtTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1318` | `RevisionTargetNode` | data | yes | `prtSchemaVersion` | `schemaVersion` | `!Text` | `(.schemaVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1319` | `RevisionTargetNode` | data | yes | `prtProvisioner` | `provisioner` | `!Text` | `(.provisioner)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1320` | `RevisionTargetNode` | data | yes | `prtProvisionerVersion` | `provisionerVersion` | `!Int` | `(.provisionerVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1321` | `RevisionTargetNode` | data | yes | `prtExpectedShape` | `expectedShape` | `!Text` | `(.expectedShape)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1322` | `RevisionTargetNode` | data | yes | `prtValidator` | `validator` | `!Text` | `(.validator)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1323` | `RevisionTargetNode` | data | yes | `prtValidatorVersion` | `validatorVersion` | `!Int` | `(.validatorVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1324` | `RevisionTargetNode` | data | yes | `prtPromotionObjects` | `promotionObjects` | `![PromotionObjectNode]` | `(.promotionObjects)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1329` | `ProjectionRevisionNode` | data | yes | `prvName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1330` | `ProjectionRevisionNode` | data | yes | `prvGroup` | `group` | `!Name` | `(.group)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1331` | `ProjectionRevisionNode` | data | yes | `prvTargets` | `targets` | `![RevisionTargetNode]` | `(.targets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1332` | `ProjectionRevisionNode` | data | yes | `prvLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1340` | `ExternalReadNode` | data | yes | `erName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1341` | `ExternalReadNode` | data | yes | `erVersion` | `version` | `!Int` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1342` | `ExternalReadNode` | data | yes | `erQueryModel` | `queryModel` | `!Name` | `(.queryModel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1343` | `ExternalReadNode` | data | yes | `erResultSchema` | `resultSchema` | `!Text` | `(.resultSchema)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1344` | `ExternalReadNode` | data | yes | `erResultType` | `resultType` | `!Text` | `(.resultType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1345` | `ExternalReadNode` | data | yes | `erCompatibleRevisions` | `compatibleRevisions` | `![Name]` | `(.compatibleRevisions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1346` | `ExternalReadNode` | data | yes | `erSurfaceGeneration` | `surfaceGeneration` | `!Int` | `(.surfaceGeneration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1347` | `ExternalReadNode` | data | yes | `erLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1382` | `ProjectionOwnerNode` | data | yes | `poName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1383` | `ProjectionOwnerNode` | data | yes | `poSources` | `sources` | `![CatalogSource]` | `(.sources)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1384` | `ProjectionOwnerNode` | data | yes | `poDelivery` | `delivery` | `!ProjectionDelivery` | `(.delivery)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1385` | `ProjectionOwnerNode` | data | yes | `poGroup` | `group` | `!Name` | `(.group)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1386` | `ProjectionOwnerNode` | data | yes | `poTargets` | `targets` | `![Name]` | `(.targets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1387` | `ProjectionOwnerNode` | data | yes | `poOrder` | `order` | `!Int` | `(.order)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1388` | `ProjectionOwnerNode` | data | yes | `poSubscription` | `subscription` | `!(Maybe Text)` | `(.subscription)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1389` | `ProjectionOwnerNode` | data | yes | `poDedup` | `dedup` | `!(Maybe Text)` | `(.dedup)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1390` | `ProjectionOwnerNode` | data | yes | `poCheckpointOnMissing` | `checkpointOnMissing` | `![CheckpointOnMissingNode]` | `(.checkpointOnMissing)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1391` | `ProjectionOwnerNode` | data | yes | `poReplay` | `replay` | `!ProjectionReplayPolicy` | `(.replay)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1392` | `ProjectionOwnerNode` | data | yes | `poLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1418` | `WorkflowNode` | data | yes | `wfId` | `id` | `!Name` | `(.id)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1420` | `WorkflowNode` | data | yes | `wfStable` | `stable` | `!Text` | `(.stable)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1421` | `WorkflowNode` | data | yes | `wfInput` | `input` | `!Name` | `(.input)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1422` | `WorkflowNode` | data | yes | `wfInputFields` | `inputFields` | `![Field]` | `(.inputFields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1423` | `WorkflowNode` | data | yes | `wfOutput` | `output` | `!Name` | `(.output)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1425` | `WorkflowNode` | data | yes | `wfIdField` | `idField` | `!(Maybe Name)` | `(.idField)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1426` | `WorkflowNode` | data | yes | `wfIdVia` | `idVia` | `!Name` | `(.idVia)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1427` | `WorkflowNode` | data | yes | `wfBody` | `body` | `![WfBodyItem]` | `(.body)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1428` | `WorkflowNode` | data | yes | `wfLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1448` | `OperationNode` | data | yes | `opName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1449` | `OperationNode` | data | yes | `opShape` | `shape` | `!OperationShape` | `(.shape)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1450` | `OperationNode` | data | yes | `opLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1496` | `Spec` | data | yes | `specContext` | `context` | `!Name` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1497` | `Spec` | data | yes | `specModuleRoot` | `moduleRoot` | `!(Maybe Text)` | `(.moduleRoot)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1498` | `Spec` | data | yes | `specLayout` | `layout` | `!(Maybe Placement)` | `(.layout)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1499` | `Spec` | data | yes | `specIds` | `ids` | `![IdDecl]` | `(.ids)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1500` | `Spec` | data | yes | `specEnums` | `enums` | `![EnumDecl]` | `(.enums)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1501` | `Spec` | data | yes | `specRules` | `rules` | `![RuleDecl]` | `(.rules)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1502` | `Spec` | data | yes | `specNominalScalars` | `nominalScalars` | `![NominalScalarDecl]` | `(.nominalScalars)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1503` | `Spec` | data | yes | `specMapped` | `mapped` | `![MappedDecl]` | `(.mapped)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Grammar.hs:1504` | `Spec` | data | yes | `specNodes` | `nodes` | `![Node]` | `(.nodes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:41` | `HaskellReference` | data | yes | `referenceModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:42` | `HaskellReference` | data | yes | `referenceName` | `name` | `!Text` | `(.name)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:43` | `HaskellReference` | data | yes | `referenceNamespace` | `namespace` | `!HaskellNamespace` | `(.namespace)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:44` | `HaskellReference` | data | yes | `referenceQualification` | `qualification` | `!QualificationPreference` | `(.qualification)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:49` | `ImportEnvironment` | data | yes | `targetModule` | `targetModule` | `!Text` | `(.targetModule)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:50` | `ImportEnvironment` | data | yes | `localNames` | `localNames` | `!(Set Text)` | `(.localNames)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:51` | `ImportEnvironment` | data | yes | `reservedQualifiers` | `reservedQualifiers` | `!(Set Text)` | `(.reservedQualifiers)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:64` | `HaskellImportPlan` | data | no | `importPlanTargetModule` | `targetModule` | `!Text` | `(.targetModule)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:65` | `HaskellImportPlan` | data | no | `importPlanDeclarations` | `declarations` | `!(Set Text)` | `(.declarations)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/HaskellImport.hs:66` | `HaskellImportPlan` | data | no | `importPlanReferences` | `references` | `!(Map HaskellReference Text)` | `(.references)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:62` | `DerivedHaskellName` | data | no | `upperCamel` | `upperCamel` | `!UpperCamelName` | `(.upperCamel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:63` | `DerivedHaskellName` | data | no | `lowerCamel` | `lowerCamel` | `!LowerCamelName` | `(.lowerCamel)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:96` | `NameSite` | data | no | `siteKind` | `kind` | `!NameSiteKind` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:97` | `NameSite` | data | no | `siteLogicalName` | `logicalName` | `!Text` | `(.logicalName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:98` | `NameSite` | data | no | `siteOwner` | `owner` | `!Text` | `(.owner)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:99` | `NameSite` | data | no | `siteLine` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:108` | `HaskellOccurrenceKey` | data | no | `occurrenceModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:109` | `HaskellOccurrenceKey` | data | no | `occurrenceSpace` | `space` | `!HaskellOccurrenceSpace` | `(.space)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:110` | `HaskellOccurrenceKey` | data | no | `occurrenceScope` | `scope` | `!Text` | `(.scope)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:111` | `HaskellOccurrenceKey` | data | no | `occurrenceName` | `name` | `!Text` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:116` | `PlannedOccurrence` | data | no | `plannedOccurrenceKey` | `key` | `!HaskellOccurrenceKey` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellName.hs:117` | `PlannedOccurrence` | data | no | `plannedOccurrenceSite` | `site` | `!NameSite` | `(.site)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:28` | `SourceMove` | data | yes | `moveRole` | `role` | `!ModuleRole` | `(.role)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:29` | `SourceMove` | data | yes | `moveKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:30` | `SourceMove` | data | yes | `moveOldModule` | `oldModule` | `!Text` | `(.oldModule)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:31` | `SourceMove` | data | yes | `moveNewModule` | `newModule` | `!Text` | `(.newModule)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:32` | `SourceMove` | data | yes | `moveOldPath` | `oldPath` | `!FilePath` | `(.oldPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:33` | `SourceMove` | data | yes | `moveNewPath` | `newPath` | `!FilePath` | `(.newPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:34` | `SourceMove` | data | yes | `moveBackupPath` | `backupPath` | `!FilePath` | `(.backupPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:38` | `SourceMove` | data | yes | `moveContentDigest` | `contentDigest` | `!(Maybe Text)` | `(.contentDigest)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/HaskellSourceMove.hs:41` | `SourceMove` | data | yes | `moveTransformedDigest` | `transformedDigest` | `!(Maybe Text)` | `(.transformedDigest)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:97` | `SourceLanguage` | data | yes | `declaredLanguageVersion` | `declaredLanguageVersion` | `!LanguageVersion` | `(.declaredLanguageVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:98` | `SourceLanguage` | data | yes | `languageVersionLoc` | `languageVersionLoc` | `!Loc` | `(.languageVersionLoc)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:120` | `SyntaxProfile` | data | no | `profileIdentifier` | `identifier` | `!Text` | `(.identifier)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:121` | `SyntaxProfile` | data | no | `profileFeatures` | `features` | `!(Set LanguageFeature)` | `(.features)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:150` | `RuntimeSemanticsProfile` | data | no | `runtimeSemanticsIdentifier` | `identifier` | `!Text` | `(.identifier)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:151` | `RuntimeSemanticsProfile` | data | no | `runtimeSemanticsCapabilities` | `capabilities` | `!(Set RuntimeCapability)` | `(.capabilities)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:208` | `LanguageDefinition` | data | yes | `definitionVersion` | `version` | `!LanguageVersion` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:209` | `LanguageDefinition` | data | yes | `definitionPredecessor` | `predecessor` | `!(Maybe LanguageVersion)` | `(.predecessor)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:212` | `LanguageDefinition` | data | yes | `definitionBodyParser` | `bodyParser` | `!LanguageBodyParser` | `(.bodyParser)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:213` | `LanguageDefinition` | data | yes | `definitionSyntaxProfile` | `syntaxProfile` | `!SyntaxProfile` | `(.syntaxProfile)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:214` | `LanguageDefinition` | data | yes | `definitionRuntimeSemanticsProfile` | `runtimeSemanticsProfile` | `!RuntimeSemanticsProfile` | `(.runtimeSemanticsProfile)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:215` | `LanguageDefinition` | data | yes | `definitionSupport` | `support` | `!LanguageSupport` | `(.support)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:216` | `LanguageDefinition` | data | yes | `definitionMaturity` | `maturity` | `!LanguageMaturity` | `(.maturity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:431` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageErrorCode` | `errorCode` | `!SourceLanguageErrorCode` | `(.errorCode)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:432` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageSource` | `source` | `!FilePath` | `(.source)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:433` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:434` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageToken` | `token` | `!(Maybe Text)` | `(.token)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:435` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageDeclaredVersion` | `declaredVersion` | `!(Maybe LanguageVersion)` | `(.declaredVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:436` | `SourceLanguageDiagnostic` | data | yes | `sourceLanguageSupportedVersions` | `supportedVersions` | `!(NonEmpty LanguageVersion)` | `(.supportedVersions)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:503` | `ParsedSource` | data | yes | `parsedSourceLanguage` | `sourceLanguage` | `!SourceLanguage` | `(.sourceLanguage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/LanguageVersion.hs:504` | `ParsedSource` | data | yes | `parsedSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedCodecPlan.hs:40` | `MappedCodecPlan` | data | yes | `consumerType` | `consumerType` | `!ConsumerTypePlan` | `(.consumerType)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedCodecPlan.hs:41` | `MappedCodecPlan` | data | yes | `resolvedExpression` | `resolvedExpression` | `!ResolvedTypeExpr` | `(.resolvedExpression)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedCodecPlan.hs:42` | `MappedCodecPlan` | data | yes | `authority` | `authority` | `!(Set MappedAuthorityMode)` | `(.authority)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:25` | `ConsumerPlan` | data | yes | `consumerPackages` | `packages` | `![Text]` | `(.packages)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:26` | `ConsumerPlan` | data | yes | `consumerModules` | `modules` | `![Text]` | `(.modules)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:27` | `ConsumerPlan` | data | yes | `consumerMappings` | `mappings` | `![MappingIdentity]` | `(.mappings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:33` | `MappingIdentity` | data | yes | `mappingSpecName` | `specName` | `!Text` | `(.specName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:34` | `MappingIdentity` | data | yes | `mappingCanonicalType` | `canonicalType` | `!Text` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:35` | `MappingIdentity` | data | yes | `mappingPackage` | `package` | `!Text` | `(.package)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:36` | `MappingIdentity` | data | yes | `mappingModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:37` | `MappingIdentity` | data | yes | `mappingType` | `valueType` | `!Text` | `(.valueType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:38` | `MappingIdentity` | data | yes | `mappingBindingSymbol` | `bindingSymbol` | `!Text` | `(.bindingSymbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:39` | `MappingIdentity` | data | yes | `mappingBindingVersion` | `bindingVersion` | `!Text` | `(.bindingVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:42` | `MappingIdentity` | data | yes | `mappingSpecName` | `specName` | `!Text` | `(.specName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:43` | `MappingIdentity` | data | yes | `mappingPackage` | `package` | `!Text` | `(.package)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:44` | `MappingIdentity` | data | yes | `mappingModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:45` | `MappingIdentity` | data | yes | `mappingType` | `valueType` | `!Text` | `(.valueType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:46` | `MappingIdentity` | data | yes | `mappingCodecIdentity` | `codecIdentity` | `!Text` | `(.codecIdentity)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:47` | `MappingIdentity` | data | yes | `mappingCodecVersion` | `codecVersion` | `!Text` | `(.codecVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:50` | `MappingIdentity` | data | yes | `mappingSpecName` | `specName` | `!Text` | `(.specName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:51` | `MappingIdentity` | data | yes | `mappingNominalCategory` | `nominalCategory` | `!Text` | `(.nominalCategory)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:52` | `MappingIdentity` | data | yes | `mappingNominalRepresentation` | `nominalRepresentation` | `!Text` | `(.nominalRepresentation)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:53` | `MappingIdentity` | data | yes | `mappingCanonicalType` | `canonicalType` | `!Text` | `(.canonicalType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:54` | `MappingIdentity` | data | yes | `mappingPackage` | `package` | `!Text` | `(.package)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:55` | `MappingIdentity` | data | yes | `mappingModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:56` | `MappingIdentity` | data | yes | `mappingType` | `valueType` | `!Text` | `(.valueType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:57` | `MappingIdentity` | data | yes | `mappingBindingSymbol` | `bindingSymbol` | `!Text` | `(.bindingSymbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:58` | `MappingIdentity` | data | yes | `mappingBindingVersion` | `bindingVersion` | `!Text` | `(.bindingVersion)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:59` | `MappingIdentity` | data | yes | `mappingFixtureSymbol` | `fixtureSymbol` | `!Text` | `(.fixtureSymbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedConsumer.hs:60` | `MappingIdentity` | data | yes | `mappingInitialSymbol` | `initialSymbol` | `!(Maybe Text)` | `(.initialSymbol)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:28` | `MappedFinding` | data | yes | `mfDeclaration` | `declaration` | `!Name` | `(.declaration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:29` | `MappedFinding` | data | yes | `mfLeaf` | `leaf` | `!Text` | `(.leaf)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:30` | `MappedFinding` | data | yes | `mfCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:31` | `MappedFinding` | data | yes | `mfDetail` | `detail` | `!Text` | `(.detail)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:32` | `MappedFinding` | data | yes | `mfUsePaths` | `usePaths` | `![UsePath]` | `(.usePaths)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/MappedDiff.hs:33` | `MappedFinding` | data | yes | `mfOldUnknownFields` | `oldUnknownFields` | `!(Maybe UnknownFields)` | `(.oldUnknownFields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:81` | `CheckedNominalEquality` | data | yes | `equalityKeyRepresentation` | `keyRepresentation` | `!NominalEqualityKey` | `(.keyRepresentation)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:82` | `CheckedNominalEquality` | data | yes | `equalityDomain` | `domain` | `!NominalEqualityDomain` | `(.domain)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:83` | `CheckedNominalEquality` | data | yes | `equalityContractVersion` | `contractVersion` | `!Text` | `(.contractVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:88` | `ConsumerNominalBinding` | data | yes | `consumerNominalHaskell` | `haskell` | `!HaskellSource` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:89` | `ConsumerNominalBinding` | data | yes | `consumerNominalBinding` | `binding` | `!QualifiedValueName` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:90` | `ConsumerNominalBinding` | data | yes | `consumerNominalBindingVersion` | `bindingVersion` | `!BindingVersion` | `(.bindingVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:91` | `ConsumerNominalBinding` | data | yes | `consumerNominalCanonical` | `canonical` | `!CanonicalTypeId` | `(.canonical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:92` | `ConsumerNominalBinding` | data | yes | `consumerNominalFixtures` | `fixtures` | `!QualifiedValueName` | `(.fixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:93` | `ConsumerNominalBinding` | data | yes | `consumerNominalInitial` | `initial` | `!(Maybe QualifiedValueName)` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:103` | `ResolvedNominalType` | data | yes | `resolvedNominalName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:104` | `ResolvedNominalType` | data | yes | `resolvedNominalRepresentation` | `representation` | `!NominalRepresentation` | `(.representation)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:105` | `ResolvedNominalType` | data | yes | `resolvedNominalOwnership` | `ownership` | `!NominalOwnership` | `(.ownership)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/NominalType.hs:106` | `ResolvedNominalType` | data | yes | `resolvedNominalLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Parser/Core.hs:75` | `ContextualParseFailure` | data | no | `contextualFailureCode` | `code` | `!SourceLanguageErrorCode` | `(.code)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Parser/Core.hs:76` | `ContextualParseFailure` | data | no | `contextualFailureFeature` | `feature` | `!(Maybe LanguageFeature)` | `(.feature)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Parser/Core.hs:77` | `ContextualParseFailure` | data | no | `contextualFailureSpan` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Parser/Preamble.hs:60` | `InitialLanguageClause` | data | no | `initialLanguageSpan` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/Parser/Preamble.hs:61` | `InitialLanguageClause` | data | no | `initialLanguageText` | `text` | `!Text` | `(.text)`, pattern, or construction | Haskell API and runtime semantics | `none` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:39` | `ProjectionMappedRoot` | data | yes | `consumer` | `consumer` | `!DerivedMappedConsumer` | `(.consumer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:40` | `ProjectionMappedRoot` | data | yes | `declaration` | `declaration` | `!MappedKey` | `(.declaration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:41` | `ProjectionMappedRoot` | data | yes | `path` | `path` | `!UsePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:49` | `ProjectionOperationalImpact` | data | yes | `consumer` | `consumer` | `!DerivedMappedConsumer` | `(.consumer)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:50` | `ProjectionOperationalImpact` | data | yes | `group` | `group` | `!(Maybe Name)` | `(.group)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:51` | `ProjectionOperationalImpact` | data | yes | `targets` | `targets` | `!(Set Name)` | `(.targets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:52` | `ProjectionOperationalImpact` | data | yes | `readModels` | `readModels` | `!(Set Name)` | `(.readModels)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:53` | `ProjectionOperationalImpact` | data | yes | `replayable` | `replayable` | `!Bool` | `(.replayable)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:54` | `ProjectionOperationalImpact` | data | yes | `sourceFingerprint` | `sourceFingerprint` | `!Text` | `(.sourceFingerprint)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:62` | `UnsupportedProjectionImpact` | data | yes | `source` | `source` | `!UnsupportedProjectionSource` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:63` | `UnsupportedProjectionImpact` | data | yes | `group` | `group` | `!Name` | `(.group)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:64` | `UnsupportedProjectionImpact` | data | yes | `targets` | `targets` | `!(Set Name)` | `(.targets)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:65` | `UnsupportedProjectionImpact` | data | yes | `readModels` | `readModels` | `!(Set Name)` | `(.readModels)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:66` | `UnsupportedProjectionImpact` | data | yes | `replayable` | `replayable` | `!Bool` | `(.replayable)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:71` | `ProjectionMappedImpact` | data | yes | `roots` | `roots` | `![ProjectionMappedRoot]` | `(.roots)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:72` | `ProjectionMappedImpact` | data | yes | `consumers` | `consumers` | `!(Map MappedKey (Set DerivedMappedConsumer))` | `(.consumers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:73` | `ProjectionMappedImpact` | data | yes | `operations` | `operations` | `!(Map DerivedMappedConsumer ProjectionOperationalImpact)` | `(.operations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionMappedImpact.hs:74` | `ProjectionMappedImpact` | data | yes | `unsupported` | `unsupported` | `![UnsupportedProjectionImpact]` | `(.unsupported)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:21` | `ResolvedProjectionSupply` | data | yes | `supplyQueryModel` | `queryModel` | `!Name` | `(.queryModel)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:22` | `ResolvedProjectionSupply` | data | yes | `supplyProjectionOwner` | `projectionOwner` | `!Name` | `(.projectionOwner)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:23` | `ResolvedProjectionSupply` | data | yes | `supplyRebuildGroup` | `rebuildGroup` | `!Name` | `(.rebuildGroup)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:24` | `ResolvedProjectionSupply` | data | yes | `supplyObservedTargets` | `observedTargets` | `!(NonEmpty Name)` | `(.observedTargets)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:25` | `ResolvedProjectionSupply` | data | yes | `supplyQueryLoc` | `queryLoc` | `!Loc` | `(.queryLoc)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:26` | `ResolvedProjectionSupply` | data | yes | `supplyOwnerLoc` | `ownerLoc` | `!Loc` | `(.ownerLoc)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:46` | `ProjectionSupplyAnalysis` | data | yes | `resolvedProjectionSupplies` | `resolvedProjectionSupplies` | `![ResolvedProjectionSupply]` | `(.resolvedProjectionSupplies)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ProjectionSupply.hs:47` | `ProjectionSupplyAnalysis` | data | yes | `projectionSupplyIssues` | `projectionSupplyIssues` | `![ProjectionSupplyIssue]` | `(.projectionSupplyIssues)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:35` | `QueryContractIdentity` | data | yes | `qciReadModel` | `readModel` | `!Name` | `(.readModel)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:36` | `QueryContractIdentity` | data | yes | `qciPosition` | `position` | `!QueryContractPosition` | `(.position)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:37` | `QueryContractIdentity` | data | yes | `qciTypeExpression` | `typeExpression` | `!Text` | `(.typeExpression)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:38` | `QueryContractIdentity` | data | yes | `qciMappedDependencies` | `mappedDependencies` | `![Name]` | `(.mappedDependencies)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:43` | `QueryContractDrift` | data | yes | `qcdKey` | `key` | `!(Name, QueryContractPosition)` | `(.key)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:44` | `QueryContractDrift` | data | yes | `qcdPrevious` | `previous` | `!(Maybe QueryContractIdentity)` | `(.previous)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReadModelQueryContract.hs:45` | `QueryContractDrift` | data | yes | `qcdCurrent` | `current` | `!(Maybe QueryContractIdentity)` | `(.current)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:46` | `AggregateImpact` | data | yes | `eventTypes` | `eventTypes` | `!(Set Name)` | `(.eventTypes)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:47` | `AggregateImpact` | data | yes | `includeSnapshotStreams` | `includeSnapshotStreams` | `!Bool` | `(.includeSnapshotStreams)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:62` | `CatalogReplayImpact` | data | yes | `affectedGroups` | `affectedGroups` | `!(Set Name)` | `(.affectedGroups)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:63` | `CatalogReplayImpact` | data | yes | `affectedTargets` | `affectedTargets` | `!(Set Name)` | `(.affectedTargets)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:64` | `CatalogReplayImpact` | data | yes | `affectedSources` | `affectedSources` | `!(Set Text)` | `(.affectedSources)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:65` | `CatalogReplayImpact` | data | yes | `affectedAdapters` | `affectedAdapters` | `!(Set Name)` | `(.affectedAdapters)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:66` | `CatalogReplayImpact` | data | yes | `invalidatesRunningFingerprint` | `invalidatesRunningFingerprint` | `!Bool` | `(.invalidatesRunningFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:207` | `ReplaySurfaceContext` | data | no | `surfaceSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:208` | `ReplaySurfaceContext` | data | no | `surfaceGraphResult` | `graphResult` | `Either (NE.NonEmpty TypeGraphError) TypeGraph` | `(.graphResult)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ReplayImpact.hs:209` | `ReplaySurfaceContext` | data | no | `surfaceSymbols` | `symbols` | `AggregateSymbols` | `(.symbols)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:52` | `CheckedReadModelQuery` | data | yes | `checkedQueryName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:53` | `CheckedReadModelQuery` | data | yes | `checkedQueryInputType` | `inputType` | `!ResolvedTypeExpr` | `(.inputType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:54` | `CheckedReadModelQuery` | data | yes | `checkedQueryResultType` | `resultType` | `!ResolvedTypeExpr` | `(.resultType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:59` | `CheckedMappedExpr` | data | yes | `checkedMappedExprRoot` | `root` | `!SelectionRoot` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:60` | `CheckedMappedExpr` | data | yes | `checkedMappedExprType` | `valueType` | `!ResolvedTypeExpr` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:65` | `CheckedMappedType` | data | yes | `checkedMappedTypeKey` | `key` | `!MappedKey` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:66` | `CheckedMappedType` | data | yes | `checkedMappedTypeConstructor` | `constructor` | `!Name` | `(.constructor)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:67` | `CheckedMappedType` | data | yes | `checkedMappedTypeFields` | `fields` | `![ResolvedWireField]` | `(.fields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:84` | `CheckedSelectionPathSegment` | data | yes | `checkedPathField` | `field` | `!Name` | `(.field)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:85` | `CheckedSelectionPathSegment` | data | yes | `checkedPathWireKey` | `wireKey` | `!Text` | `(.wireKey)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:86` | `CheckedSelectionPathSegment` | data | yes | `checkedPathOwner` | `owner` | `!MappedKey` | `(.owner)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:91` | `CheckedScalarExpr` | data | yes | `checkedScalarType` | `valueType` | `!SelectionScalarType` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:92` | `CheckedScalarExpr` | data | yes | `checkedScalarNode` | `node` | `!CheckedScalarNode` | `(.node)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:93` | `CheckedScalarExpr` | data | yes | `checkedScalarLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:133` | `CheckedRouterSelection` | data | yes | `checkedIdentity` | `identity` | `!Text` | `(.identity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:134` | `CheckedRouterSelection` | data | yes | `checkedVersion` | `version` | `!Natural` | `(.version)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:135` | `CheckedRouterSelection` | data | yes | `checkedQuery` | `query` | `!CheckedReadModelQuery` | `(.query)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:136` | `CheckedRouterSelection` | data | yes | `checkedInputBinding` | `inputBinding` | `!CheckedMappedExpr` | `(.inputBinding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:137` | `CheckedRouterSelection` | data | yes | `checkedRowBinding` | `rowBinding` | `!CheckedMappedType` | `(.rowBinding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:138` | `CheckedRouterSelection` | data | yes | `checkedKey` | `key` | `!CheckedScalarExpr` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:139` | `CheckedRouterSelection` | data | yes | `checkedPredicate` | `predicate` | `!CheckedScalarExpr` | `(.predicate)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:140` | `CheckedRouterSelection` | data | yes | `checkedRecipient` | `recipient` | `!CheckedScalarExpr` | `(.recipient)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:141` | `CheckedRouterSelection` | data | yes | `checkedCommandFields` | `commandFields` | `!(Map Name CheckedScalarExpr)` | `(.commandFields)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:142` | `CheckedRouterSelection` | data | yes | `checkedTarget` | `target` | `!Name` | `(.target)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:143` | `CheckedRouterSelection` | data | yes | `checkedCommand` | `command` | `!Name` | `(.command)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:144` | `CheckedRouterSelection` | data | yes | `checkedLimit` | `limit` | `!Natural` | `(.limit)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:145` | `CheckedRouterSelection` | data | yes | `checkedOrder` | `order` | `!CheckedSelectionOrder` | `(.order)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:146` | `CheckedRouterSelection` | data | yes | `checkedDedupe` | `dedupe` | `!CheckedSelectionDedupe` | `(.dedupe)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:147` | `CheckedRouterSelection` | data | yes | `checkedEmptyPolicy` | `emptyPolicy` | `!CheckedEmptySelectionPolicy` | `(.emptyPolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:148` | `CheckedRouterSelection` | data | yes | `checkedFailurePolicy` | `failurePolicy` | `!CheckedSelectionFailurePolicy` | `(.failurePolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:149` | `CheckedRouterSelection` | data | yes | `checkedRedeliveryPolicy` | `redeliveryPolicy` | `!CheckedRedeliveryPolicy` | `(.redeliveryPolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:150` | `CheckedRouterSelection` | data | yes | `checkedPartialPolicy` | `partialPolicy` | `!CheckedPartialDispatchPolicy` | `(.partialPolicy)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:151` | `CheckedRouterSelection` | data | yes | `checkedFingerprint` | `fingerprint` | `!Text` | `(.fingerprint)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:152` | `CheckedRouterSelection` | data | yes | `checkedUseSites` | `useSites` | `![UseSite]` | `(.useSites)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:189` | `RouterSelectionDiagnostic` | data | yes | `selectionDiagnosticLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:190` | `RouterSelectionDiagnostic` | data | yes | `selectionDiagnosticCode` | `code` | `!RouterSelectionDiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RouterSelection.hs:191` | `RouterSelectionDiagnostic` | data | yes | `selectionDiagnosticMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/RuntimePackage.hs:18` | `RuntimePackageName` | newtype | yes | `unRuntimePackageName` | `unRuntimePackageName` | `Text` | explicit `unRuntimePackageName` positional function | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:153` | `ScaffoldModule` | data | yes | `modulePath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:154` | `ScaffoldModule` | data | yes | `moduleText` | `text` | `!Text` | `(.text)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:155` | `ScaffoldModule` | data | yes | `kind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:156` | `ScaffoldModule` | data | yes | `origin` | `origin` | `!Text` | `(.origin)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:164` | `ModuleRole` | data | yes | `roleOwnerKind` | `ownerKind` | `!Text` | `(.ownerKind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:165` | `ModuleRole` | data | yes | `roleOwnerName` | `ownerName` | `!Text` | `(.ownerName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:166` | `ModuleRole` | data | yes | `roleFamily` | `family` | `!Text` | `(.family)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:197` | `Context` | data | yes | `contextName` | `name` | `!Text` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:199` | `Context` | data | yes | `moduleRoot` | `moduleRoot` | `!Text` | `(.moduleRoot)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:201` | `Context` | data | yes | `placement` | `placement` | `!Placement` | `(.placement)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:209` | `NominalUseSite` | data | yes | `nominalUseAggregate` | `aggregate` | `!Name` | `(.aggregate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:210` | `NominalUseSite` | data | yes | `nominalUseKind` | `kind` | `!AggregateUseSite` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:218` | `NominalGenerationOwner` | data | yes | `nominalDeclaration` | `declaration` | `!ResolvedNominalType` | `(.declaration)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:219` | `NominalGenerationOwner` | data | yes | `nominalModule` | `moduleName` | `!Text` | `(.moduleName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:220` | `NominalGenerationOwner` | data | yes | `nominalUseSites` | `useSites` | `!(Set.Set NominalUseSite)` | `(.useSites)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:221` | `NominalGenerationOwner` | data | yes | `nominalEqualityUsed` | `equalityUsed` | `!Bool` | `(.equalityUsed)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:333` | `FirewallSurface` | data | yes | `forbiddenSymbolic` | `forbiddenSymbolic` | `![Text]` | `(.forbiddenSymbolic)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:334` | `FirewallSurface` | data | yes | `forbiddenIdents` | `forbiddenIdents` | `![Text]` | `(.forbiddenIdents)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:335` | `FirewallSurface` | data | yes | `forbiddenQualifiers` | `forbiddenQualifiers` | `![Text]` | `(.forbiddenQualifiers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:336` | `FirewallSurface` | data | yes | `forbiddenImports` | `forbiddenImports` | `![Text]` | `(.forbiddenImports)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:337` | `FirewallSurface` | data | yes | `restrictedImports` | `restrictedImports` | `![(Text, [Text])]` | `(.restrictedImports)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:488` | `Agg` | data | yes | `aContext` | `context` | `!Context` | `(.context)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:489` | `Agg` | data | yes | `aCheckedService` | `checkedService` | `!CheckedService` | `(.checkedService)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:490` | `Agg` | data | yes | `aLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:491` | `Agg` | data | yes | `aSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:492` | `Agg` | data | yes | `aAggregate` | `aggregate` | `!Aggregate` | `(.aggregate)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:493` | `Agg` | data | yes | `aCtxPascal` | `ctxPascal` | `!Text` | `(.ctxPascal)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:494` | `Agg` | data | yes | `aName` | `name` | `!Text` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:495` | `Agg` | data | yes | `aLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:496` | `Agg` | data | yes | `aVertexType` | `vertexType` | `!Text` | `(.vertexType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:497` | `Agg` | data | yes | `aIds` | `ids` | `![IdDecl]` | `(.ids)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:498` | `Agg` | data | yes | `aEnums` | `enums` | `![EnumDecl]` | `(.enums)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:499` | `Agg` | data | yes | `aRegs` | `regs` | `![ResolvedRegister]` | `(.regs)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:500` | `Agg` | data | yes | `aStates` | `states` | `![StateDecl]` | `(.states)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:501` | `Agg` | data | yes | `aCommands` | `commands` | `![ResolvedCtor]` | `(.commands)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:502` | `Agg` | data | yes | `aEvents` | `events` | `![ResolvedCtor]` | `(.events)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:503` | `Agg` | data | yes | `aDomainOutcomeTypes` | `domainOutcomeTypes` | `!(Maybe ResolvedDomainOutcomeTypes)` | `(.domainOutcomeTypes)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:505` | `Agg` | data | yes | `aGeneratedNominals` | `generatedNominals` | `![ResolvedNominalType]` | `(.generatedNominals)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:506` | `Agg` | data | yes | `aTransitions` | `transitions` | `![Transition]` | `(.transitions)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:507` | `Agg` | data | yes | `aOutputMappings` | `outputMappings` | `!(Map.Map (Int, Int) EventOutputMapping)` | `(.outputMappings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:508` | `Agg` | data | yes | `aWire` | `wire` | `!WireSpec` | `(.wire)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:509` | `Agg` | data | yes | `aProjection` | `projection` | `!(Maybe ProjectionSpec)` | `(.projection)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:510` | `Agg` | data | yes | `aSnapshot` | `snapshot` | `!(Maybe SnapshotSpec)` | `(.snapshot)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:511` | `Agg` | data | yes | `aFoldFingerprint` | `foldFingerprint` | `!Text` | `(.foldFingerprint)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:512` | `Agg` | data | yes | `aReadModels` | `readModels` | `![ReadModelNode]` | `(.readModels)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:513` | `Agg` | data | yes | `aTypeGraph` | `typeGraph` | `!(Maybe TypeGraph)` | `(.typeGraph)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:514` | `Agg` | data | yes | `aSymbols` | `symbols` | `!AggregateSymbols` | `(.symbols)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:516` | `Agg` | data | yes | `aGenPrefix` | `genPrefix` | `!Text` | `(.genPrefix)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:518` | `Agg` | data | yes | `aHolePrefix` | `holePrefix` | `!Text` | `(.holePrefix)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:522` | `ResolvedDomainOutcomeTypes` | data | yes | `resolvedRejectionType` | `rejectionType` | `!ResolvedAggregateType` | `(.rejectionType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:523` | `ResolvedDomainOutcomeTypes` | data | yes | `resolvedNoOpType` | `noOpType` | `!ResolvedAggregateType` | `(.noOpType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:531` | `ResolvedRegister` | data | yes | `rrName` | `name` | `!Name` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:532` | `ResolvedRegister` | data | yes | `rrType` | `valueType` | `!ResolvedAggregateType` | `(.valueType)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:533` | `ResolvedRegister` | data | yes | `rrInitial` | `initial` | `!ResolvedRegisterInitial` | `(.initial)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:534` | `ResolvedRegister` | data | yes | `rrLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:541` | `ResolvedCtor` | data | yes | `rcName` | `name` | `!Text` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:543` | `ResolvedCtor` | data | yes | `rcFields` | `fields` | `![(ResolvedFieldIdentity, ResolvedAggregateType)]` | `(.fields)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:545` | `ResolvedCtor` | data | yes | `rcVersion` | `version` | `!Int` | `(.version)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:547` | `ResolvedCtor` | data | yes | `rcUpcastFrom` | `upcastFrom` | `!(Maybe Int)` | `(.upcastFrom)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2155` | `RenderedShapeType` | data | no | `renderedShapeTypePrecedence` | `precedence` | `!ShapeTypePrecedence` | `(.precedence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2156` | `RenderedShapeType` | data | no | `renderedShapeTypeText` | `text` | `!Text` | `(.text)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2171` | `StructuralProjection` | data | yes | `spTag` | `tag` | `!Text` | `(.tag)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2172` | `StructuralProjection` | data | yes | `spWitness` | `witness` | `!Text` | `(.witness)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2173` | `StructuralProjection` | data | yes | `spPointer` | `pointer` | `!Text` | `(.pointer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2174` | `StructuralProjection` | data | yes | `spOwner` | `owner` | `!HaskellSource` | `(.owner)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2175` | `StructuralProjection` | data | yes | `spResult` | `result` | `!Text` | `(.result)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2176` | `StructuralProjection` | data | yes | `spCanonical` | `canonical` | `!CanonicalTypeId` | `(.canonical)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2177` | `StructuralProjection` | data | yes | `spBinding` | `binding` | `!QualifiedValueName` | `(.binding)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:2178` | `StructuralProjection` | data | yes | `spSelectors` | `selectors` | `![(Text, Text)]` | `(.selectors)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:3638` | `ResolvedQueueField` | data | no | `resolvedQueueField` | `field` | `!WqField` | `(.field)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:3639` | `ResolvedQueueField` | data | no | `resolvedQueueExpression` | `expression` | `!(Maybe ResolvedTypeExpr)` | `(.expression)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:3640` | `ResolvedQueueField` | data | no | `resolvedQueueCodecPlan` | `codecPlan` | `!(Maybe MappedCodecPlan)` | `(.codecPlan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6857` | `ResolvedGeneratedTransition` | data | no | `resolvedTransitionIndex` | `index` | `!Int` | `(.index)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6858` | `ResolvedGeneratedTransition` | data | no | `resolvedTransitionSource` | `source` | `!Transition` | `(.source)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6859` | `ResolvedGeneratedTransition` | data | no | `resolvedTransitionGuard` | `guard` | `!(Maybe TypedScalarExpr)` | `(.guard)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6860` | `ResolvedGeneratedTransition` | data | no | `resolvedTransitionWrites` | `writes` | `![(Name, TypedScalarExpr)]` | `(.writes)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6868` | `ResolvedSilentOutcome` | data | no | `resolvedSilentLayout` | `layout` | `!TransitionLayoutEntry` | `(.layout)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6869` | `ResolvedSilentOutcome` | data | no | `resolvedSilentKind` | `kind` | `!SilentOutcomeKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:6870` | `ResolvedSilentOutcome` | data | no | `resolvedSilentReason` | `reason` | `!TypedScalarExpr` | `(.reason)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:7006` | `ProjectionAlias` | data | no | `projectionAliasTarget` | `target` | `!ProjectionAliasTarget` | `(.target)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:7007` | `ProjectionAlias` | data | no | `projectionAliasName` | `name` | `!Text` | `(.name)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:7083` | `RenderedKeikiExpr` | data | no | `renderedKeikiText` | `text` | `!Text` | `(.text)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Scaffold.hs:7084` | `RenderedKeikiExpr` | data | no | `renderedKeikiPrecedence` | `precedence` | `!Int` | `(.precedence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:42` | `ScaffoldRecord` | data | yes | `recSpecPath` | `specPath` | `!Text` | `(.specPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:43` | `ScaffoldRecord` | data | yes | `recModuleRoot` | `moduleRoot` | `!Text` | `(.moduleRoot)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:44` | `ScaffoldRecord` | data | yes | `recLayout` | `layout` | `!Text` | `(.layout)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:45` | `ScaffoldRecord` | data | yes | `recSourceLanguage` | `sourceLanguage` | `!SourceLanguage` | `(.sourceLanguage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:46` | `ScaffoldRecord` | data | yes | `recLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:47` | `ScaffoldRecord` | data | yes | `recNamingEdition` | `namingEdition` | `!GeneratedHaskellNamingEdition` | `(.namingEdition)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:48` | `ScaffoldRecord` | data | yes | `recModuleRoles` | `moduleRoles` | `![ScaffoldModuleRoleRow]` | `(.moduleRoles)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:49` | `ScaffoldRecord` | data | yes | `recFiles` | `files` | `![(ModuleKind, FilePath)]` | `(.files)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:50` | `ScaffoldRecord` | data | yes | `recMappings` | `mappings` | `![MappingIdentity]` | `(.mappings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:51` | `ScaffoldRecord` | data | yes | `recIdDomains` | `idDomains` | `![Text]` | `(.idDomains)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:52` | `ScaffoldRecord` | data | yes | `recNominalEqualities` | `nominalEqualities` | `![Text]` | `(.nominalEqualities)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:53` | `ScaffoldRecord` | data | yes | `recBindingObligations` | `bindingObligations` | `![BindingHole]` | `(.bindingObligations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:54` | `ScaffoldRecord` | data | yes | `recBehaviorRequirements` | `behaviorRequirements` | `![BehaviorRecordRow]` | `(.behaviorRequirements)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:55` | `ScaffoldRecord` | data | yes | `recProjectionCatalogFacts` | `projectionCatalogFacts` | `![Text]` | `(.projectionCatalogFacts)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:56` | `ScaffoldRecord` | data | yes | `recQueryContractBaseline` | `queryContractBaseline` | `!Bool` | `(.queryContractBaseline)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:57` | `ScaffoldRecord` | data | yes | `recQueryContracts` | `queryContracts` | `![QueryContractIdentity]` | `(.queryContracts)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:58` | `ScaffoldRecord` | data | yes | `recRouterSelections` | `routerSelections` | `![RouterSelectionSnapshot]` | `(.routerSelections)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:59` | `ScaffoldRecord` | data | yes | `recSemanticImpact` | `semanticImpact` | `!(Maybe SemanticImpactSnapshot)` | `(.semanticImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:64` | `ScaffoldModuleRoleRow` | data | yes | `srrRole` | `role` | `!ModuleRole` | `(.role)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:65` | `ScaffoldModuleRoleRow` | data | yes | `srrKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRecord.hs:66` | `ScaffoldModuleRoleRow` | data | yes | `srrPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:195` | `GeneratedHaskellEditionUse` | data | yes | `path` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:196` | `GeneratedHaskellEditionUse` | data | yes | `line` | `line` | `!Int` | `(.line)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:197` | `GeneratedHaskellEditionUse` | data | yes | `current` | `current` | `!Text` | `(.current)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:198` | `GeneratedHaskellEditionUse` | data | yes | `replacement` | `replacement` | `!Text` | `(.replacement)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:199` | `GeneratedHaskellEditionUse` | data | yes | `form` | `form` | `!HoleUseForm` | `(.form)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:212` | `GeneratedHaskellEditionImpact` | data | yes | `fromEdition` | `fromEdition` | `!HaskellName.GeneratedHaskellNamingEdition` | `(.fromEdition)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:213` | `GeneratedHaskellEditionImpact` | data | yes | `generatedPaths` | `generatedPaths` | `![FilePath]` | `(.generatedPaths)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:214` | `GeneratedHaskellEditionImpact` | data | yes | `sidecarPaths` | `sidecarPaths` | `![FilePath]` | `(.sidecarPaths)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:215` | `GeneratedHaskellEditionImpact` | data | yes | `handOwnedUses` | `handOwnedUses` | `![GeneratedHaskellEditionUse]` | `(.handOwnedUses)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:220` | `PreparedGeneratedHaskellEditionMigration` | data | no | `impact` | `impact` | `!GeneratedHaskellEditionImpact` | `(.impact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:221` | `PreparedGeneratedHaskellEditionMigration` | data | no | `backups` | `backups` | `![(FilePath, FilePath)]` | `(.backups)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:222` | `PreparedGeneratedHaskellEditionMigration` | data | no | `reportPath` | `reportPath` | `!FilePath` | `(.reportPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:223` | `PreparedGeneratedHaskellEditionMigration` | data | no | `reportText` | `reportText` | `!Text` | `(.reportText)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:224` | `PreparedGeneratedHaskellEditionMigration` | data | no | `sourceMoves` | `sourceMoves` | `![SourceMove]` | `(.sourceMoves)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:245` | `GeneratedArtifactImpact` | data | yes | `artifactCategory` | `category` | `!GeneratedArtifactCategory` | `(.category)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:246` | `GeneratedArtifactImpact` | data | yes | `artifactRole` | `role` | `!ModuleRole` | `(.role)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:247` | `GeneratedArtifactImpact` | data | yes | `artifactPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:248` | `GeneratedArtifactImpact` | data | yes | `artifactDisposition` | `disposition` | `!WriteDisposition` | `(.disposition)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:258` | `StaleModule` | data | yes | `staleKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:259` | `StaleModule` | data | yes | `stalePath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:260` | `StaleModule` | data | yes | `staleGeneratedEvidence` | `generatedEvidence` | `!(Maybe StaleGeneratedEvidence)` | `(.generatedEvidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:265` | `MappingDrift` | data | yes | `driftSpecName` | `specName` | `!Text` | `(.specName)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:266` | `MappingDrift` | data | yes | `driftPrevious` | `previous` | `!(Maybe MappingIdentity)` | `(.previous)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:267` | `MappingDrift` | data | yes | `driftCurrent` | `current` | `!(Maybe MappingIdentity)` | `(.current)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:272` | `SourceLanguageDrift` | data | yes | `languageDriftPrevious` | `previous` | `!SourceLanguage` | `(.previous)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:273` | `SourceLanguageDrift` | data | yes | `languageDriftCurrent` | `current` | `!SourceLanguage` | `(.current)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:278` | `ScaffoldReport` | data | yes | `reportSpecPath` | `specPath` | `!FilePath` | `(.specPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:279` | `ScaffoldReport` | data | yes | `reportOutDir` | `outDir` | `!FilePath` | `(.outDir)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:280` | `ScaffoldReport` | data | yes | `reportContext` | `context` | `!Context` | `(.context)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:281` | `ScaffoldReport` | data | yes | `reportDispositions` | `dispositions` | `![(ScaffoldModule, WriteDisposition)]` | `(.dispositions)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:282` | `ScaffoldReport` | data | yes | `reportInertNodes` | `inertNodes` | `![(Text, Text)]` | `(.inertNodes)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:283` | `ScaffoldReport` | data | yes | `reportManifestPath` | `manifestPath` | `!FilePath` | `(.manifestPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:284` | `ScaffoldReport` | data | yes | `reportRecordPath` | `recordPath` | `!FilePath` | `(.recordPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:285` | `ScaffoldReport` | data | yes | `reportPreviousSpecPath` | `previousSpecPath` | `!(Maybe Text)` | `(.previousSpecPath)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:286` | `ScaffoldReport` | data | yes | `reportStale` | `stale` | `![StaleModule]` | `(.stale)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:287` | `ScaffoldReport` | data | yes | `reportConsumerPlan` | `consumerPlan` | `!ConsumerPlan` | `(.consumerPlan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:288` | `ScaffoldReport` | data | yes | `reportConstraintPlan` | `constraintPlan` | `![Text]` | `(.constraintPlan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:289` | `ScaffoldReport` | data | yes | `reportMappingDrift` | `mappingDrift` | `![MappingDrift]` | `(.mappingDrift)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:290` | `ScaffoldReport` | data | yes | `reportQueryContractBaselineUnavailable` | `queryContractBaselineUnavailable` | `!Bool` | `(.queryContractBaselineUnavailable)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:291` | `ScaffoldReport` | data | yes | `reportQueryContractDrift` | `queryContractDrift` | `![QueryContractDrift]` | `(.queryContractDrift)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:292` | `ScaffoldReport` | data | yes | `reportQueryContractMigrations` | `queryContractMigrations` | `![QueryContractMigration]` | `(.queryContractMigrations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:293` | `ScaffoldReport` | data | yes | `reportSemanticImpact` | `semanticImpact` | `!SemanticImpactReport` | `(.semanticImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:294` | `ScaffoldReport` | data | yes | `reportRouterSelectionDrift` | `routerSelectionDrift` | `![RouterSelectionDrift]` | `(.routerSelectionDrift)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:295` | `ScaffoldReport` | data | yes | `reportProjectionMappedImpact` | `projectionMappedImpact` | `!(Maybe ProjectionMappedImpact)` | `(.projectionMappedImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:296` | `ScaffoldReport` | data | yes | `reportGeneratedArtifactImpact` | `generatedArtifactImpact` | `![GeneratedArtifactImpact]` | `(.generatedArtifactImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:297` | `ScaffoldReport` | data | yes | `reportSourceLanguageDrift` | `sourceLanguageDrift` | `!(Maybe SourceLanguageDrift)` | `(.sourceLanguageDrift)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:298` | `ScaffoldReport` | data | yes | `reportNewHoles` | `newHoles` | `![BindingHole]` | `(.newHoles)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:299` | `ScaffoldReport` | data | yes | `reportAddedBehavior` | `addedBehavior` | `![BehaviorRecordRow]` | `(.addedBehavior)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:300` | `ScaffoldReport` | data | yes | `reportRemovedBehavior` | `removedBehavior` | `![BehaviorRecordRow]` | `(.removedBehavior)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:301` | `ScaffoldReport` | data | yes | `reportObsoleteOutputHooks` | `obsoleteOutputHooks` | `![(Text, Text)]` | `(.obsoleteOutputHooks)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:302` | `ScaffoldReport` | data | yes | `reportConformancePackage` | `conformancePackage` | `!(Maybe ConformancePackageReport)` | `(.conformancePackage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:303` | `ScaffoldReport` | data | yes | `reportNameMoves` | `nameMoves` | `![SourceMove]` | `(.nameMoves)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:304` | `ScaffoldReport` | data | yes | `reportSidecarMoves` | `sidecarMoves` | `![SidecarMove]` | `(.sidecarMoves)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:309` | `QueryContractMigration` | data | yes | `qcmOwner` | `owner` | `!Text` | `(.owner)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:310` | `QueryContractMigration` | data | yes | `path` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/ScaffoldRun.hs:311` | `QueryContractMigration` | data | yes | `qcmRequiredImport` | `requiredImport` | `!Text` | `(.requiredImport)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:63` | `EffectiveLanguageContract` | data | yes | `effectiveContractLanguageVersion` | `contractLanguageVersion` | `!LanguageVersion` | `(.contractLanguageVersion)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:64` | `EffectiveLanguageContract` | data | yes | `effectiveRuntimeProfile` | `runtimeProfile` | `!RuntimeSemanticsProfile` | `(.runtimeProfile)`, pattern, or construction | serialized/wire review risk | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:160` | `CheckedService` | data | no | `serviceLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | serialized/wire review risk | `none` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:161` | `CheckedService` | data | no | `serviceSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | serialized/wire review risk | `none` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:162` | `CheckedService` | data | no | `serviceTypeGraph` | `typeGraph` | `Either (NonEmpty TypeGraphError) TypeGraph` | `(.typeGraph)`, pattern, or construction | serialized/wire review risk | `none` |+| `keiro-dsl/src/Keiro/Dsl/SemanticContract.hs:163` | `CheckedService` | data | no | `serviceProjectionSupplies` | `projectionSupplies` | `ProjectionSupplyAnalysis` | `(.projectionSupplies)`, pattern, or construction | serialized/wire review risk | `none` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:100` | `MappedRoot` | data | yes | `mappedRootConsumer` | `consumer` | `!MappedConsumer` | `(.consumer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:101` | `MappedRoot` | data | yes | `mappedRootKind` | `kind` | `!MappedRootKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:102` | `MappedRoot` | data | yes | `mappedRootUseSite` | `useSite` | `!UseSite` | `(.useSite)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:103` | `MappedRoot` | data | yes | `mappedRootDeclaration` | `declaration` | `!MappedKey` | `(.declaration)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:111` | `MappedRootEvidence` | data | yes | `evidenceConsumer` | `consumer` | `!MappedConsumer` | `(.consumer)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:112` | `MappedRootEvidence` | data | yes | `evidenceRootKind` | `rootKind` | `!MappedRootKind` | `(.rootKind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:113` | `MappedRootEvidence` | data | yes | `evidencePath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:114` | `MappedRootEvidence` | data | yes | `evidenceOperation` | `operation` | `!(Maybe Text)` | `(.operation)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:141` | `SemanticImpact` | data | yes | `impactRoots` | `roots` | `![MappedRoot]` | `(.roots)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:142` | `SemanticImpact` | data | yes | `impactUsePaths` | `usePaths` | `!(Map MappedKey [UsePath])` | `(.usePaths)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:143` | `SemanticImpact` | data | yes | `impactAggregateDeclarations` | `aggregateDeclarations` | `!(Map MappedConsumer (Set MappedKey))` | `(.aggregateDeclarations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:144` | `SemanticImpact` | data | yes | `impactDeclarationConsumers` | `declarationConsumers` | `!(Map MappedKey (Set MappedConsumer))` | `(.declarationConsumers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:145` | `SemanticImpact` | data | yes | `impactDeclarationEvidence` | `declarationEvidence` | `!(Map MappedKey (Set MappedRootEvidence))` | `(.declarationEvidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:146` | `SemanticImpact` | data | yes | `impactDeclarationConsequences` | `declarationConsequences` | `!(Map MappedKey (Set MappedConsequence))` | `(.declarationConsequences)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:147` | `SemanticImpact` | data | yes | `impactServiceDeclarations` | `serviceDeclarations` | `!(Set MappedKey)` | `(.serviceDeclarations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:148` | `SemanticImpact` | data | yes | `impactDeclarationIdentities` | `declarationIdentities` | `!(Map MappedKey Text)` | `(.declarationIdentities)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:149` | `SemanticImpact` | data | yes | `impactUnsupportedProjectionSources` | `unsupportedProjectionSources` | `![UnsupportedProjectionSource]` | `(.unsupportedProjectionSources)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:159` | `SemanticImpactSnapshot` | data | yes | `snapshotMappedConsumers` | `mappedConsumers` | `!(Map MappedKey (Set MappedConsumer))` | `(.mappedConsumers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:160` | `SemanticImpactSnapshot` | data | yes | `snapshotMappedEvidence` | `mappedEvidence` | `!(Maybe (Map MappedKey (Set MappedRootEvidence)))` | `(.mappedEvidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:161` | `SemanticImpactSnapshot` | data | yes | `snapshotMappedConsequences` | `mappedConsequences` | `!(Maybe (Map MappedKey (Set MappedConsequence)))` | `(.mappedConsequences)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:162` | `SemanticImpactSnapshot` | data | yes | `snapshotServiceInventory` | `serviceInventory` | `!(Set MappedKey)` | `(.serviceInventory)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:163` | `SemanticImpactSnapshot` | data | yes | `snapshotDeclarationIdentities` | `declarationIdentities` | `!(Map MappedKey Text)` | `(.declarationIdentities)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:170` | `MappedImpactDelta` | data | yes | `impactDeclaration` | `declaration` | `!MappedKey` | `(.declaration)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:171` | `MappedImpactDelta` | data | yes | `impactPreviousConsumers` | `previousConsumers` | `!(Set MappedConsumer)` | `(.previousConsumers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:172` | `MappedImpactDelta` | data | yes | `impactCurrentConsumers` | `currentConsumers` | `!(Set MappedConsumer)` | `(.currentConsumers)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:173` | `MappedImpactDelta` | data | yes | `impactPreviousEvidence` | `previousEvidence` | `!(Maybe (Set MappedRootEvidence))` | `(.previousEvidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:174` | `MappedImpactDelta` | data | yes | `impactCurrentEvidence` | `currentEvidence` | `!(Maybe (Set MappedRootEvidence))` | `(.currentEvidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:175` | `MappedImpactDelta` | data | yes | `impactPreviousConsequences` | `previousConsequences` | `!(Maybe (Set MappedConsequence))` | `(.previousConsequences)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:176` | `MappedImpactDelta` | data | yes | `impactCurrentConsequences` | `currentConsequences` | `!(Maybe (Set MappedConsequence))` | `(.currentConsequences)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:177` | `MappedImpactDelta` | data | yes | `impactServiceConformance` | `serviceConformance` | `!Bool` | `(.serviceConformance)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:185` | `SemanticImpactReport` | data | yes | `semanticReportPrevious` | `previous` | `!(Maybe SemanticImpactSnapshot)` | `(.previous)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:186` | `SemanticImpactReport` | data | yes | `semanticReportCurrent` | `current` | `!SemanticImpactSnapshot` | `(.current)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:187` | `SemanticImpactReport` | data | yes | `semanticReportDeclarations` | `declarations` | `![MappedKey]` | `(.declarations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:188` | `SemanticImpactReport` | data | yes | `semanticReportDeltas` | `deltas` | `![MappedImpactDelta]` | `(.deltas)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:514` | `SelectionEvidence` | data | no | `selectionEvidenceRoot` | `root` | `!MappedRoot` | `(.root)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/SemanticImpact.hs:515` | `SelectionEvidence` | data | no | `selectionEvidencePath` | `path` | `!Text` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/ServiceHarness.hs:28` | `DuplicateServiceFactKey` | newtype | yes | `duplicateServiceFactKey` | `duplicateServiceFactKey` | `Text` | `(.duplicateServiceFactKey)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SidecarMigration.hs:48` | `SidecarMove` | data | yes | `sidecarOldPath` | `oldPath` | `!FilePath` | `(.oldPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SidecarMigration.hs:49` | `SidecarMove` | data | yes | `sidecarNewPath` | `newPath` | `!FilePath` | `(.newPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SidecarMigration.hs:50` | `SidecarMove` | data | yes | `sidecarBackupPath` | `backupPath` | `!(Maybe FilePath)` | `(.backupPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/SidecarMigration.hs:51` | `SidecarMove` | data | yes | `sidecarMoveDisposition` | `moveDisposition` | `!SidecarMoveDisposition` | `(.moveDisposition)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:22` | `SourcePoint` | data | yes | `offset` | `offset` | `!Int` | `(.offset)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:23` | `SourcePoint` | data | yes | `line` | `line` | `!Int` | `(.line)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:24` | `SourcePoint` | data | yes | `column` | `column` | `!Int` | `(.column)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:38` | `SourceSpan` | data | yes | `source` | `source` | `!FilePath` | `(.source)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:39` | `SourceSpan` | data | yes | `start` | `start` | `!SourcePoint` | `(.start)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:40` | `SourceSpan` | data | yes | `end` | `end` | `!SourcePoint` | `(.end)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:61` | `Located` | data | yes | `span` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Functor, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Source.hs:62` | `Located` | data | yes | `value` | `value` | `!a` | `(.value)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Ord, Show, Functor, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:60` | `IndexedSourcePosition` | data | no | `quality` | `quality` | `!SourcePositionQuality` | `(.quality)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:61` | `IndexedSourcePosition` | data | no | `span` | `span` | `!SourceSpan` | `(.span)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:66` | `SemanticSourceIndex` | newtype | no | `positions` | `positions` | `Map SourceSubject IndexedSourcePosition` | `(.positions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:72` | `ParsedSourceDocument` | data | yes | `documentParsedSource` | `parsedSource` | `!ParsedSource` | `(.parsedSource)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:73` | `ParsedSourceDocument` | data | yes | `documentSourceIndex` | `sourceIndex` | `!SemanticSourceIndex` | `(.sourceIndex)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:85` | `SourceIndexFailure` | data | yes | `failureCode` | `code` | `!SourceIndexFailureCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:86` | `SourceIndexFailure` | data | yes | `failureSubject` | `subject` | `!(Maybe SourceSubject)` | `(.subject)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:87` | `SourceIndexFailure` | data | yes | `failureSpan` | `span` | `!(Maybe SourceSpan)` | `(.span)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/SourceIndex.hs:88` | `SourceIndexFailure` | data | yes | `failureMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:78` | `ConformanceRendering` | data | no | `renderingContext` | `context` | `!Context` | `(.context)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:79` | `ConformanceRendering` | data | no | `renderingGraph` | `graph` | `!TypeGraph` | `(.graph)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:80` | `ConformanceRendering` | data | no | `renderingDeclarations` | `declarations` | `![ResolvedMappedDecl]` | `(.declarations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:81` | `ConformanceRendering` | data | no | `renderingProjections` | `projections` | `![StructuralProjection]` | `(.projections)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/StructuralConformance.hs:82` | `ConformanceRendering` | data | no | `renderingImportPlan` | `importPlan` | `!HaskellImportPlan` | `(.importPlan)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:33` | `SurfaceSource` | data | yes | `source` | `source` | `!FilePath` | `(.source)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:34` | `SurfaceSource` | data | yes | `language` | `language` | `!SourceLanguage` | `(.language)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:35` | `SurfaceSource` | data | yes | `preamble` | `preamble` | `!(Maybe (Located SourceLanguage))` | `(.preamble)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:36` | `SurfaceSource` | data | yes | `spec` | `spec` | `!(Located SurfaceSpec)` | `(.spec)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:43` | `SurfaceSpec` | data | yes | `context` | `context` | `!(Located Text)` | `(.context)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:44` | `SurfaceSpec` | data | yes | `moduleRoot` | `moduleRoot` | `!(Maybe (Located Text))` | `(.moduleRoot)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:45` | `SurfaceSpec` | data | yes | `layout` | `layout` | `!(Maybe (Located Placement))` | `(.layout)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:46` | `SurfaceSpec` | data | yes | `items` | `items` | `![Located SurfaceTopItem]` | `(.items)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/Syntax.hs:47` | `SurfaceSpec` | data | yes | `elements` | `elements` | `![Located SurfaceElement]` | `(.elements)`, pattern, or construction | Haskell API and runtime semantics | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:77` | `QualifiedValueName` | newtype | yes | `unQualifiedValueName` | `unQualifiedValueName` | `Text` | explicit `unQualifiedValueName` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:83` | `CanonicalTypeId` | newtype | yes | `unCanonicalTypeId` | `unCanonicalTypeId` | `Text` | explicit `unCanonicalTypeId` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:89` | `BindingVersion` | newtype | yes | `unBindingVersion` | `unBindingVersion` | `Text` | explicit `unBindingVersion` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:95` | `CodecIdentity` | newtype | yes | `unCodecIdentity` | `unCodecIdentity` | `Text` | explicit `unCodecIdentity` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:101` | `CodecVersion` | newtype | yes | `unCodecVersion` | `unCodecVersion` | `Text` | explicit `unCodecVersion` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:148` | `StructuralDecl` | data | yes | `sdName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:149` | `StructuralDecl` | data | yes | `sdHaskell` | `haskell` | `!HaskellSource` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:150` | `StructuralDecl` | data | yes | `sdBinding` | `binding` | `!QualifiedValueName` | `(.binding)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:151` | `StructuralDecl` | data | yes | `sdBindingVersion` | `bindingVersion` | `!BindingVersion` | `(.bindingVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:152` | `StructuralDecl` | data | yes | `sdCanonical` | `canonical` | `!CanonicalTypeId` | `(.canonical)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:153` | `StructuralDecl` | data | yes | `sdFixtures` | `fixtures` | `!QualifiedValueName` | `(.fixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:154` | `StructuralDecl` | data | yes | `sdInitial` | `initial` | `!(Maybe QualifiedValueName)` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:155` | `StructuralDecl` | data | yes | `sdLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:160` | `OpaqueDecl` | data | yes | `odName` | `name` | `!Name` | `(.name)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:161` | `OpaqueDecl` | data | yes | `odHaskell` | `haskell` | `!HaskellSource` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:162` | `OpaqueDecl` | data | yes | `odCodecIdentity` | `codecIdentity` | `!CodecIdentity` | `(.codecIdentity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:163` | `OpaqueDecl` | data | yes | `odCodecVersion` | `codecVersion` | `!CodecVersion` | `(.codecVersion)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:164` | `OpaqueDecl` | data | yes | `odFixtures` | `fixtures` | `!QualifiedValueName` | `(.fixtures)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:165` | `OpaqueDecl` | data | yes | `odInitial` | `initial` | `!(Maybe QualifiedValueName)` | `(.initial)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:166` | `OpaqueDecl` | data | yes | `odLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:222` | `MappedKey` | newtype | yes | `unMappedKey` | `unMappedKey` | `Name` | explicit `unMappedKey` positional function | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:243` | `ResolvedWireField` | data | yes | `rwfHaskell` | `haskell` | `!Name` | `(.haskell)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:244` | `ResolvedWireField` | data | yes | `rwfKey` | `key` | `!Text` | `(.key)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:245` | `ResolvedWireField` | data | yes | `rwfType` | `valueType` | `!ResolvedTypeExpr` | `(.valueType)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:246` | `ResolvedWireField` | data | yes | `rwfPresence` | `presence` | `!Presence` | `(.presence)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:247` | `ResolvedWireField` | data | yes | `rwfOnMissing` | `onMissing` | `!(Maybe OnMissing)` | `(.onMissing)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:248` | `ResolvedWireField` | data | yes | `rwfLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:253` | `ResolvedWireArm` | data | yes | `rwaCtor` | `ctor` | `!Name` | `(.ctor)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:254` | `ResolvedWireArm` | data | yes | `rwaTag` | `tag` | `!Text` | `(.tag)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:255` | `ResolvedWireArm` | data | yes | `rwaPayload` | `payload` | `!(Maybe ResolvedTypeExpr)` | `(.payload)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:256` | `ResolvedWireArm` | data | yes | `rwaLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:298` | `UsePath` | data | yes | `upRoot` | `root` | `!UseSite` | `(.root)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:299` | `UsePath` | data | yes | `upSegments` | `segments` | `![PathSeg]` | `(.segments)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Ord, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:319` | `TypeGraph` | data | yes | `tgDeclarations` | `declarations` | `!(Map MappedKey ResolvedMappedDecl)` | `(.declarations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:320` | `TypeGraph` | data | yes | `tgReachability` | `reachability` | `!(Map MappedKey (Set MappedKey))` | `(.reachability)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:321` | `TypeGraph` | data | yes | `tgUseSites` | `useSites` | `![UseSite]` | `(.useSites)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:322` | `TypeGraph` | data | yes | `tgRootSegments` | `rootSegments` | `!(Map UseSite [PathSeg])` | `(.rootSegments)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:323` | `TypeGraph` | data | yes | `tgDerivedMappedConsumers` | `derivedMappedConsumers` | `![DerivedMappedConsumer]` | `(.derivedMappedConsumers)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:324` | `TypeGraph` | data | yes | `tgReplayableProjectionGroups` | `replayableProjectionGroups` | `!(Map DerivedMappedConsumer Name)` | `(.replayableProjectionGroups)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:325` | `TypeGraph` | data | yes | `tgProjectionOperationalIdentities` | `projectionOperationalIdentities` | `!(Map DerivedMappedConsumer Text)` | `(.projectionOperationalIdentities)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:326` | `TypeGraph` | data | yes | `tgUnsupportedProjectionSources` | `unsupportedProjectionSources` | `![UnsupportedProjectionSource]` | `(.unsupportedProjectionSources)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show, Generic)` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:746` | `TypeExprAlgebra` | data | yes | `onText` | `onText` | `a` | `(.onText)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:747` | `TypeExprAlgebra` | data | yes | `onInt` | `onInt` | `a` | `(.onInt)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:748` | `TypeExprAlgebra` | data | yes | `onInteger` | `onInteger` | `a` | `(.onInteger)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:749` | `TypeExprAlgebra` | data | yes | `onBool` | `onBool` | `a` | `(.onBool)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:750` | `TypeExprAlgebra` | data | yes | `onNatural` | `onNatural` | `a` | `(.onNatural)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:751` | `TypeExprAlgebra` | data | yes | `onTime` | `onTime` | `a` | `(.onTime)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:752` | `TypeExprAlgebra` | data | yes | `onJson` | `onJson` | `a` | `(.onJson)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:753` | `TypeExprAlgebra` | data | yes | `onOptional` | `onOptional` | `a -> a` | `(.onOptional)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:754` | `TypeExprAlgebra` | data | yes | `onList` | `onList` | `a -> a` | `(.onList)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:755` | `TypeExprAlgebra` | data | yes | `onMap` | `onMap` | `a -> a` | `(.onMap)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:756` | `TypeExprAlgebra` | data | yes | `onRef` | `onRef` | `MappedKey -> a` | `(.onRef)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:774` | `MappedShapeAlgebra` | data | yes | `onRecord` | `onRecord` | `Name -> UnknownFields -> [ResolvedWireField] -> a` | `(.onRecord)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:775` | `MappedShapeAlgebra` | data | yes | `onEnum` | `onEnum` | `[WireEnum] -> a` | `(.onEnum)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:776` | `MappedShapeAlgebra` | data | yes | `onUnion` | `onUnion` | `UnionEncoding -> [ResolvedWireArm] -> a` | `(.onUnion)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:786` | `MappedDeclAlgebra` | data | yes | `onStructuralDecl` | `onStructuralDecl` | `StructuralDecl -> ResolvedMappedShape -> a` | `(.onStructuralDecl)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/TypeGraph.hs:787` | `MappedDeclAlgebra` | data | yes | `onOpaqueDecl` | `onOpaqueDecl` | `OpaqueDecl -> a` | `(.onOpaqueDecl)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:711` | `Diagnostic` | data | yes | `line` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:712` | `Diagnostic` | data | yes | `severity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:713` | `Diagnostic` | data | yes | `code` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:714` | `Diagnostic` | data | yes | `relatedLocations` | `relatedLocations` | `![(Int, Text)]` | `(.relatedLocations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:715` | `Diagnostic` | data | yes | `message` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:1423` | `NullabilityFacts` | data | no | `nfTopNull` | `topNull` | `!Bool` | `(.topNull)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Validate.hs:1424` | `NullabilityFacts` | data | no | `nfBadOptional` | `badOptional` | `!Bool` | `(.badOptional)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:140` | `WorkspaceManifest` | data | yes | `wmfService` | `service` | `!Text` | `(.service)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:141` | `WorkspaceManifest` | data | yes | `wmfServiceLoc` | `serviceLoc` | `!Loc` | `(.serviceLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:143` | `WorkspaceManifest` | data | yes | `wmfRuntimePackage` | `runtimePackage` | `!(Maybe RuntimePackageName)` | `(.runtimePackage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:145` | `WorkspaceManifest` | data | yes | `wmfRuntimePackageLoc` | `runtimePackageLoc` | `!Loc` | `(.runtimePackageLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:147` | `WorkspaceManifest` | data | yes | `wmfModuleRoot` | `moduleRoot` | `!(Maybe Text)` | `(.moduleRoot)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:149` | `WorkspaceManifest` | data | yes | `wmfModuleRootLoc` | `moduleRootLoc` | `!Loc` | `(.moduleRootLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:151` | `WorkspaceManifest` | data | yes | `wmfLayout` | `layout` | `!(Maybe Placement)` | `(.layout)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:153` | `WorkspaceManifest` | data | yes | `wmfLayoutLoc` | `layoutLoc` | `!Loc` | `(.layoutLoc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:155` | `WorkspaceManifest` | data | yes | `wmfMembers` | `members` | `!(NonEmpty WorkspaceMemberRef)` | `(.members)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:162` | `WorkspaceMemberRef` | data | yes | `wmrPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:163` | `WorkspaceMemberRef` | data | yes | `wmrLoc` | `loc` | `!Loc` | `(.loc)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:542` | `WorkspaceLocation` | data | yes | `wlFile` | `file` | `!WorkspaceFile` | `(.file)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:543` | `WorkspaceLocation` | data | yes | `wlLine` | `line` | `!Int` | `(.line)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:544` | `WorkspaceLocation` | data | yes | `wlRole` | `role` | `!Text` | `(.role)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:554` | `WorkspaceDiagnostic` | data | yes | `wdLocations` | `locations` | `!(NonEmpty WorkspaceLocation)` | `(.locations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:555` | `WorkspaceDiagnostic` | data | yes | `wdSeverity` | `severity` | `!Severity` | `(.severity)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:556` | `WorkspaceDiagnostic` | data | yes | `wdCode` | `code` | `!DiagnosticCode` | `(.code)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:557` | `WorkspaceDiagnostic` | data | yes | `wdSourceLanguageCause` | `sourceLanguageCause` | `!(Maybe SourceLanguageDiagnostic)` | `(.sourceLanguageCause)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:558` | `WorkspaceDiagnostic` | data | yes | `wdMessage` | `message` | `!Text` | `(.message)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:625` | `LineMap` | newtype | yes | `lmRanges` | `lmRanges` | `[(Int, Int, FilePath)]` | `(.lmRanges)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:634` | `OwnershipIndex` | data | yes | `oiDeclarations` | `declarations` | `!(Map (Text, Name) (FilePath, Loc))` | `(.declarations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:635` | `OwnershipIndex` | data | yes | `oiNodes` | `nodes` | `!(Map (Text, Name) (FilePath, Loc))` | `(.nodes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:650` | `WorkspaceMember` | data | yes | `wmPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:652` | `WorkspaceMember` | data | yes | `wmSpec` | `spec` | `!Spec` | `(.spec)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:654` | `WorkspaceMember` | data | yes | `wmSourceLanguage` | `sourceLanguage` | `!SourceLanguage` | `(.sourceLanguage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:657` | `WorkspaceMember` | data | yes | `wmSourceIndex` | `sourceIndex` | `!SemanticSourceIndex` | `(.sourceIndex)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:659` | `WorkspaceMember` | data | yes | `wmLineBase` | `lineBase` | `!Int` | `(.lineBase)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:661` | `WorkspaceMember` | data | yes | `wmLineCount` | `lineCount` | `!Int` | `(.lineCount)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:677` | `WorkspaceSpec` | data | yes | `wsService` | `service` | `!Text` | `(.service)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:678` | `WorkspaceSpec` | data | yes | `wsManifestPath` | `manifestPath` | `!FilePath` | `(.manifestPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:681` | `WorkspaceSpec` | data | yes | `wsLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:683` | `WorkspaceSpec` | data | yes | `wsContext` | `context` | `!Name` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:684` | `WorkspaceSpec` | data | yes | `wsRuntimePackage` | `runtimePackage` | `!(Maybe RuntimePackageName)` | `(.runtimePackage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:685` | `WorkspaceSpec` | data | yes | `wsModuleRoot` | `moduleRoot` | `!(Maybe Text)` | `(.moduleRoot)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:686` | `WorkspaceSpec` | data | yes | `wsLayout` | `layout` | `!(Maybe Placement)` | `(.layout)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:688` | `WorkspaceSpec` | data | yes | `wsMembers` | `members` | `![WorkspaceMember]` | `(.members)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:689` | `WorkspaceSpec` | data | yes | `wsMergedSpec` | `mergedSpec` | `!Spec` | `(.mergedSpec)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:691` | `WorkspaceSpec` | data | yes | `wsSourceIndex` | `sourceIndex` | `!SemanticSourceIndex` | `(.sourceIndex)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:692` | `WorkspaceSpec` | data | yes | `wsLineMap` | `lineMap` | `!LineMap` | `(.lineMap)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:693` | `WorkspaceSpec` | data | yes | `wsOwnership` | `ownership` | `!OwnershipIndex` | `(.ownership)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/Workspace.hs:1306` | `ContentSource` | newtype | yes | `csRead` | `csRead` | `FilePath -> IO (Either Text Text)` | `(.csRead)`, pattern, or construction | rendered/canonical output | `none` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:63` | `ClaimedFile` | data | yes | `cfPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:64` | `ClaimedFile` | data | yes | `cfEvidence` | `evidence` | `!ClaimEvidence` | `(.evidence)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:66` | `ClaimedFile` | data | yes | `cfSource` | `source` | `!(Maybe Text)` | `(.source)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:68` | `ClaimedFile` | data | yes | `cfSpec` | `spec` | `!(Maybe Text)` | `(.spec)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:75` | `MigrationReport` | data | yes | `mrService` | `service` | `!Text` | `(.service)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:77` | `MigrationReport` | data | yes | `mrLegacyRecord` | `legacyRecord` | `!(Maybe (FilePath, Text))` | `(.legacyRecord)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:78` | `MigrationReport` | data | yes | `mrClaimed` | `claimed` | `![ClaimedFile]` | `(.claimed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:79` | `MigrationReport` | data | yes | `mrLikelyStale` | `likelyStale` | `![StaleModule]` | `(.likelyStale)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceAdoption.hs:80` | `MigrationReport` | data | yes | `mrUnclaimed` | `unclaimed` | `![FilePath]` | `(.unclaimed)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:82` | `WorkspaceModuleRow` | data | yes | `wrmKind` | `kind` | `!ModuleKind` | `(.kind)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:83` | `WorkspaceModuleRow` | data | yes | `wrmPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:84` | `WorkspaceModuleRow` | data | yes | `wrmOwner` | `owner` | `!(Maybe FilePath)` | `(.owner)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:85` | `WorkspaceModuleRow` | data | yes | `wrmRole` | `role` | `!(Maybe ModuleRole)` | `(.role)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:126` | `WorkspaceSourceLanguageRow` | data | yes | `wrslPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:127` | `WorkspaceSourceLanguageRow` | data | yes | `wrslSourceLanguage` | `sourceLanguage` | `!SourceLanguage` | `(.sourceLanguage)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:159` | `AdoptedRow` | data | yes | `adPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:160` | `AdoptedRow` | data | yes | `adEvidence` | `evidence` | `!Text` | `(.evidence)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:162` | `AdoptedRow` | data | yes | `adSource` | `source` | `!(Maybe Text)` | `(.source)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:164` | `AdoptedRow` | data | yes | `adSpec` | `spec` | `!(Maybe Text)` | `(.spec)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:192` | `WorkspaceRecord` | data | yes | `wrService` | `service` | `!Text` | `(.service)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:197` | `WorkspaceRecord` | data | yes | `wrManifest` | `manifest` | `!Text` | `(.manifest)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:198` | `WorkspaceRecord` | data | yes | `wrContext` | `context` | `!Text` | `(.context)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:199` | `WorkspaceRecord` | data | yes | `wrModuleRoot` | `moduleRoot` | `!Text` | `(.moduleRoot)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:200` | `WorkspaceRecord` | data | yes | `wrLayout` | `layout` | `!Text` | `(.layout)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:202` | `WorkspaceRecord` | data | yes | `wrMembers` | `members` | `![FilePath]` | `(.members)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:203` | `WorkspaceRecord` | data | yes | `wrSourceLanguages` | `sourceLanguages` | `![WorkspaceSourceLanguageRow]` | `(.sourceLanguages)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:204` | `WorkspaceRecord` | data | yes | `wrLanguageContract` | `languageContract` | `!EffectiveLanguageContract` | `(.languageContract)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:205` | `WorkspaceRecord` | data | yes | `wrNamingEdition` | `namingEdition` | `!GeneratedHaskellNamingEdition` | `(.namingEdition)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:206` | `WorkspaceRecord` | data | yes | `wrModules` | `modules` | `![WorkspaceModuleRow]` | `(.modules)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:207` | `WorkspaceRecord` | data | yes | `wrMappings` | `mappings` | `![MappingIdentity]` | `(.mappings)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:208` | `WorkspaceRecord` | data | yes | `wrIdDomains` | `idDomains` | `![Text]` | `(.idDomains)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:209` | `WorkspaceRecord` | data | yes | `wrNominalEqualities` | `nominalEqualities` | `![Text]` | `(.nominalEqualities)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:210` | `WorkspaceRecord` | data | yes | `wrBindingObligations` | `bindingObligations` | `![BindingHole]` | `(.bindingObligations)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:211` | `WorkspaceRecord` | data | yes | `requirements` | `requirements` | `![BehaviorRecordRow]` | `(.requirements)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:212` | `WorkspaceRecord` | data | yes | `wrProjectionCatalogFacts` | `projectionCatalogFacts` | `![Text]` | `(.projectionCatalogFacts)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:213` | `WorkspaceRecord` | data | yes | `wrQueryContractBaseline` | `queryContractBaseline` | `!Bool` | `(.queryContractBaseline)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:214` | `WorkspaceRecord` | data | yes | `wrQueryContracts` | `queryContracts` | `![QueryContractIdentity]` | `(.queryContracts)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:215` | `WorkspaceRecord` | data | yes | `wrRouterSelections` | `routerSelections` | `![RouterSelectionSnapshot]` | `(.routerSelections)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:216` | `WorkspaceRecord` | data | yes | `wrAdopted` | `adopted` | `![AdoptedRow]` | `(.adopted)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceRecord.hs:217` | `WorkspaceRecord` | data | yes | `wrSemanticImpact` | `semanticImpact` | `!(Maybe SemanticImpactSnapshot)` | `(.semanticImpact)`, pattern, or construction | serialized/wire review risk, rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:167` | `WorkspacePlan` | data | yes | `wpWorkspace` | `workspace` | `!WorkspaceSpec` | `(.workspace)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:168` | `WorkspacePlan` | data | yes | `wpCheckedService` | `checkedService` | `!CheckedService` | `(.checkedService)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:169` | `WorkspacePlan` | data | yes | `wpContext` | `context` | `!Context` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:170` | `WorkspacePlan` | data | yes | `wpRuntimePackage` | `runtimePackage` | `!(Maybe RuntimePackageName)` | `(.runtimePackage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:171` | `WorkspacePlan` | data | yes | `wpConformancePackage` | `conformancePackage` | `!(Maybe ConformancePackagePlan)` | `(.conformancePackage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:175` | `WorkspacePlan` | data | yes | `wpGoldenRoot` | `goldenRoot` | `!FilePath` | `(.goldenRoot)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:176` | `WorkspacePlan` | data | yes | `wpModules` | `modules` | `![(ScaffoldModule, ModuleProvenance)]` | `(.modules)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:401` | `OwnershipMove` | data | yes | `omPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:402` | `OwnershipMove` | data | yes | `omPrevious` | `previous` | `!(Maybe FilePath)` | `(.previous)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:403` | `OwnershipMove` | data | yes | `omCurrent` | `current` | `!(Maybe FilePath)` | `(.current)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:408` | `WorkspaceSourceLanguageDrift` | data | yes | `wsldPath` | `path` | `!FilePath` | `(.path)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:409` | `WorkspaceSourceLanguageDrift` | data | yes | `wsldPrevious` | `previous` | `!SourceLanguage` | `(.previous)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:410` | `WorkspaceSourceLanguageDrift` | data | yes | `wsldCurrent` | `current` | `!SourceLanguage` | `(.current)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:416` | `WorkspaceScaffoldReport` | data | yes | `wsrManifestPath` | `manifestPath` | `!FilePath` | `(.manifestPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:417` | `WorkspaceScaffoldReport` | data | yes | `wsrOutDir` | `outDir` | `!FilePath` | `(.outDir)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:418` | `WorkspaceScaffoldReport` | data | yes | `wsrService` | `service` | `!Text` | `(.service)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:419` | `WorkspaceScaffoldReport` | data | yes | `wsrContext` | `context` | `!Context` | `(.context)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:420` | `WorkspaceScaffoldReport` | data | yes | `wsrMembers` | `members` | `![FilePath]` | `(.members)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:421` | `WorkspaceScaffoldReport` | data | yes | `wsrDispositions` | `dispositions` | `![(ScaffoldModule, ModuleProvenance, WriteDisposition)]` | `(.dispositions)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:422` | `WorkspaceScaffoldReport` | data | yes | `wsrBuildManifestPath` | `buildManifestPath` | `!FilePath` | `(.buildManifestPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:423` | `WorkspaceScaffoldReport` | data | yes | `wsrRecordPath` | `recordPath` | `!FilePath` | `(.recordPath)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:426` | `WorkspaceScaffoldReport` | data | yes | `wsrPreviousManifest` | `previousManifest` | `!(Maybe Text)` | `(.previousManifest)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:427` | `WorkspaceScaffoldReport` | data | yes | `wsrStale` | `stale` | `![StaleModule]` | `(.stale)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:428` | `WorkspaceScaffoldReport` | data | yes | `wsrOwnershipMoves` | `ownershipMoves` | `![OwnershipMove]` | `(.ownershipMoves)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:429` | `WorkspaceScaffoldReport` | data | yes | `wsrConsumerPlan` | `consumerPlan` | `!ConsumerPlan` | `(.consumerPlan)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:430` | `WorkspaceScaffoldReport` | data | yes | `wsrConstraintPlan` | `constraintPlan` | `![Text]` | `(.constraintPlan)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:431` | `WorkspaceScaffoldReport` | data | yes | `wsrMappingDrift` | `mappingDrift` | `![MappingDrift]` | `(.mappingDrift)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:432` | `WorkspaceScaffoldReport` | data | yes | `wsrQueryContractBaselineUnavailable` | `queryContractBaselineUnavailable` | `!Bool` | `(.queryContractBaselineUnavailable)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:433` | `WorkspaceScaffoldReport` | data | yes | `wsrQueryContractDrift` | `queryContractDrift` | `![QueryContractDrift]` | `(.queryContractDrift)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:434` | `WorkspaceScaffoldReport` | data | yes | `wsrQueryContractMigrations` | `queryContractMigrations` | `![QueryContractMigration]` | `(.queryContractMigrations)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:435` | `WorkspaceScaffoldReport` | data | yes | `wsrSemanticImpact` | `semanticImpact` | `!SemanticImpactReport` | `(.semanticImpact)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:436` | `WorkspaceScaffoldReport` | data | yes | `wsrRouterSelectionDrift` | `routerSelectionDrift` | `![RouterSelectionDrift]` | `(.routerSelectionDrift)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:437` | `WorkspaceScaffoldReport` | data | yes | `wsrProjectionMappedImpact` | `projectionMappedImpact` | `!(Maybe ProjectionMappedImpact)` | `(.projectionMappedImpact)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:438` | `WorkspaceScaffoldReport` | data | yes | `wsrGeneratedArtifactImpact` | `generatedArtifactImpact` | `![GeneratedArtifactImpact]` | `(.generatedArtifactImpact)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:439` | `WorkspaceScaffoldReport` | data | yes | `wsrSourceLanguageDrift` | `sourceLanguageDrift` | `![WorkspaceSourceLanguageDrift]` | `(.sourceLanguageDrift)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:440` | `WorkspaceScaffoldReport` | data | yes | `wsrNewHoles` | `newHoles` | `![BindingHole]` | `(.newHoles)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:441` | `WorkspaceScaffoldReport` | data | yes | `wsrAddedBehavior` | `addedBehavior` | `![BehaviorRecordRow]` | `(.addedBehavior)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:442` | `WorkspaceScaffoldReport` | data | yes | `wsrRemovedBehavior` | `removedBehavior` | `![BehaviorRecordRow]` | `(.removedBehavior)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:443` | `WorkspaceScaffoldReport` | data | yes | `wsrObsoleteOutputHooks` | `obsoleteOutputHooks` | `![(Text, Text)]` | `(.obsoleteOutputHooks)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:447` | `WorkspaceScaffoldReport` | data | yes | `wsrInertNodes` | `inertNodes` | `![(Text, Text)]` | `(.inertNodes)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:448` | `WorkspaceScaffoldReport` | data | yes | `wsrConformancePackage` | `conformancePackage` | `!(Maybe ConformancePackageReport)` | `(.conformancePackage)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:449` | `WorkspaceScaffoldReport` | data | yes | `wsrNameMoves` | `nameMoves` | `![SourceMove]` | `(.nameMoves)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:450` | `WorkspaceScaffoldReport` | data | yes | `wsrSidecarMoves` | `sidecarMoves` | `![SidecarMove]` | `(.sidecarMoves)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |+| `keiro-dsl/src/Keiro/Dsl/WorkspaceScaffold.hs:452` | `WorkspaceScaffoldReport` | data | yes | `wsrMigration` | `migration` | `!(Maybe MigrationReport)` | `(.migration)`, pattern, or construction | rendered/canonical output | `deriving stock (Eq, Show)` |++Regenerate or check this inventory with:++```bash+python3 scripts/generate-record-migration-manifests.py --check+```

src/Keiro/Dsl/AggregateGenerationPlan.hs view

@@ -11,9 +11,9 @@ import Keiro.Dsl.Grammar (Name, Transition (..))  data TransitionLayoutEntry = TransitionLayoutEntry-  { layoutDeclarationIndex :: !Int,-    layoutOutgoingIndex :: !Int,-    layoutTransition :: !Transition+  { declarationIndex :: !Int,+    outgoingIndex :: !Int,+    transition :: !Transition   }   deriving stock (Eq, Show) @@ -21,7 +21,7 @@ transitionLayout transitions = snd (mapAccumL buildEntry Map.empty (zip [1 ..] transitions))   where     buildEntry counts (declarationIndex, transition) =-      let source = tSource transition+      let source = (.source) transition           outgoingIndex = Map.findWithDefault 0 source counts           counts' = Map.insert source (outgoingIndex + 1) counts           entry = TransitionLayoutEntry declarationIndex outgoingIndex transition@@ -30,7 +30,7 @@ groupTransitionLayoutBySource :: [TransitionLayoutEntry] -> [(Name, [TransitionLayoutEntry])] groupTransitionLayoutBySource entries =   [ (source, transitionLayoutForSource source entries)-  | source <- firstOccurrences (map (tSource . layoutTransition) entries)+  | source <- firstOccurrences (map ((.source) . (.transition)) entries)   ]   where     firstOccurrences = foldl appendNew []@@ -39,4 +39,4 @@       | otherwise = seen ++ [value]  transitionLayoutForSource :: Name -> [TransitionLayoutEntry] -> [TransitionLayoutEntry]-transitionLayoutForSource source = filter ((== source) . tSource . layoutTransition)+transitionLayoutForSource source = filter ((== source) . (.source) . (.transition))

src/Keiro/Dsl/AggregateType.hs view

@@ -82,9 +82,9 @@   deriving stock (Eq, Ord, Show)  data AggregateSymbols = AggregateSymbols-  { symbolNominals :: !(Map Name ResolvedNominalType),-    symbolVertices :: !(Map Name [Name]),-    symbolMapped :: !(Map MappedKey ResolvedMappedDecl)+  { nominals :: !(Map Name ResolvedNominalType),+    vertices :: !(Map Name [Name]),+    mapped :: !(Map MappedKey ResolvedMappedDecl)   }  aggregateSymbols :: Spec -> AggregateSymbols@@ -92,22 +92,22 @@   aggregateSymbolsFromGraphResult (resolveTypeGraph spec) spec  aggregateSymbolsFromGraph :: TypeGraph -> Spec -> AggregateSymbols-aggregateSymbolsFromGraph graph = aggregateSymbolsFromDeclarations (tgDeclarations graph)+aggregateSymbolsFromGraph graph = aggregateSymbolsFromDeclarations ((.declarations) graph)  aggregateSymbolsFromGraphResult :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> AggregateSymbols aggregateSymbolsFromGraphResult graphResult =-  aggregateSymbolsFromDeclarations (either (const Map.empty) tgDeclarations graphResult)+  aggregateSymbolsFromDeclarations (either (const Map.empty) (.declarations) graphResult)  aggregateSymbolsFromDeclarations :: Map MappedKey ResolvedMappedDecl -> Spec -> AggregateSymbols aggregateSymbolsFromDeclarations mappedDeclarations spec =   AggregateSymbols-    { symbolNominals = either (const Map.empty) nominalTypes (resolveNominalTypes spec),-      symbolVertices =+    { nominals = either (const Map.empty) nominalTypes (resolveNominalTypes spec),+      vertices =         Map.fromList-          [ (aggName aggregate <> "Vertex", map stName (aggStates aggregate))-          | NAggregate aggregate <- specNodes spec+          [ ((.name) aggregate <> "Vertex", map (.name) ((.states) aggregate))+          | NAggregate aggregate <- (.nodes) spec           ],-      symbolMapped = mappedDeclarations+      mapped = mappedDeclarations     }  data AggregateTypeErrorReason@@ -118,9 +118,9 @@   deriving stock (Eq, Show)  data AggregateTypeError = AggregateTypeError-  { aggregateTypeErrorLoc :: !Loc,-    aggregateTypeErrorUseSite :: !AggregateUseSite,-    aggregateTypeErrorReason :: !AggregateTypeErrorReason+  { loc :: !Loc,+    useSite :: !AggregateUseSite,+    reason :: !AggregateTypeErrorReason   }   deriving stock (Eq, Show) @@ -138,9 +138,9 @@     TList {} -> unsupportedShape     TMap {} -> unsupportedShape     TRef name-      | Just nominal <- Map.lookup name (symbolNominals symbols) -> pure (AggregateNominal nominal)-      | Map.member name (symbolVertices symbols) -> pure (AggregateVertex name)-      | Map.member (MappedKey name) (symbolMapped symbols) -> pure (AggregateMapped (MappedKey name))+      | Just nominal <- Map.lookup name ((.nominals) symbols) -> pure (AggregateNominal nominal)+      | Map.member name ((.vertices) symbols) -> pure (AggregateVertex name)+      | Map.member (MappedKey name) ((.mapped) symbols) -> pure (AggregateMapped (MappedKey name))       | otherwise -> Left (AggregateTypeError loc useSite (UnknownAggregateType name))   case aggregateCapability useSite resolved of     Unsupported -> Left (AggregateTypeError loc useSite (UnsupportedAggregateCapability resolved))@@ -151,17 +151,17 @@  inferAggregateFieldType :: AggregateSymbols -> Aggregate -> AggregateUseSite -> AggregateField -> Either AggregateTypeError ResolvedAggregateType inferAggregateFieldType symbols aggregate useSite field =-  resolveAggregateType symbols (aggregateFieldLoc field) useSite inferred+  resolveAggregateType symbols ((.loc) field) useSite inferred   where-    inferred = case aggregateFieldType field of+    inferred = case (.valueType) field of       Just expression -> expression-      Nothing -> case [regType register | register <- aggRegs aggregate, regName register == aggregateFieldName field] of+      Nothing -> case [(.valueType) register | register <- (.regs) aggregate, (.name) register == (.name) field] of         expression : _ -> expression         [] ->-          let candidate = pascal (aggregateFieldName field)-           in if Map.member candidate (symbolNominals symbols)-                || Map.member candidate (symbolVertices symbols)-                || Map.member (MappedKey candidate) (symbolMapped symbols)+          let candidate = pascal ((.name) field)+           in if Map.member candidate ((.nominals) symbols)+                || Map.member candidate ((.vertices) symbols)+                || Map.member (MappedKey candidate) ((.mapped) symbols)                 then TRef candidate                 else TText @@ -169,7 +169,7 @@ aggregateCapability useSite resolved = case useSite of   EqualityGuardUse -> case resolved of     AggregateMapped {} -> Unsupported-    AggregateNominal nominal -> case resolvedNominalRepresentation nominal of+    AggregateNominal nominal -> case (.representation) nominal of       ScalarRepresentation {} -> SolverVisible       IdRepresentation {} -> SolverVisible       EnumRepresentation {} -> SolverVisible@@ -206,13 +206,13 @@   AggregateMapped {} -> OpaqueOnly  nominalSolverVisibility :: ResolvedNominalType -> AggregateCapability-nominalSolverVisibility nominal = case resolvedNominalRepresentation nominal of+nominalSolverVisibility nominal = case (.representation) nominal of   ScalarRepresentation {} -> SolverVisible   IdRepresentation {} -> OpaqueOnly   EnumRepresentation {} -> OpaqueOnly  nominalOrderingCapability :: ResolvedNominalType -> AggregateCapability-nominalOrderingCapability nominal = case resolvedNominalRepresentation nominal of+nominalOrderingCapability nominal = case (.representation) nominal of   ScalarRepresentation NominalInt -> SolverVisible   ScalarRepresentation NominalNatural -> SolverVisible   ScalarRepresentation NominalTime -> SolverVisible@@ -229,7 +229,7 @@   AggregateBool -> "Bool"   AggregateTime -> "Time"   AggregateNatural -> "Natural"-  AggregateNominal nominal -> resolvedNominalName nominal+  AggregateNominal nominal -> (.name) nominal   AggregateVertex name -> name   AggregateMapped key -> unMappedKey key @@ -248,19 +248,19 @@   TRef name -> name  data AggregateHaskellSource = AggregateHaskellSource-  { aggregateSourceBuiltin :: !(Maybe Text),-    aggregateSourceReference :: !(Maybe HaskellReference),-    aggregateSourceStaticImports :: !(Set Text)+  { builtin :: !(Maybe Text),+    reference :: !(Maybe HaskellReference),+    staticImports :: !(Set Text)   }  aggregateConsumerHaskellSource :: AggregateSymbols -> ResolvedAggregateType -> AggregateHaskellSource aggregateConsumerHaskellSource symbols resolved = case resolved of   AggregateTime -> builtin "UTCTime" timeImports   AggregateNatural -> builtin "Natural" (Set.singleton "Numeric.Natural (Natural)")-  AggregateNominal nominal -> case resolvedNominalOwnership nominal of-    GeneratedNominal -> builtin (resolvedNominalName nominal) Set.empty-    ConsumerNominal binding -> external (consumerNominalHaskell binding)-  AggregateMapped key -> case Map.lookup key (symbolMapped symbols) of+  AggregateNominal nominal -> case (.ownership) nominal of+    GeneratedNominal -> builtin ((.name) nominal) Set.empty+    ConsumerNominal binding -> external ((.haskell) binding)+  AggregateMapped key -> case Map.lookup key ((.mapped) symbols) of     Just declaration -> external (mappedHaskell declaration)     Nothing -> builtin (unMappedKey key) Set.empty   _ -> builtin (aggregateCanonicalName resolved) Set.empty@@ -269,18 +269,21 @@     external source =       AggregateHaskellSource         Nothing-        (Just (HaskellReference (hsModule source) (hsType source) TypeNamespace PreferUnqualified))+        (Just (HaskellReference ((.moduleName) source) ((.valueType) source) TypeNamespace PreferUnqualified))         Set.empty-    mappedHaskell (ResolvedStructural declaration _) = sdHaskell declaration-    mappedHaskell (ResolvedOpaque declaration) = odHaskell declaration+    mappedHaskell (ResolvedStructural declaration _) = (.haskell) declaration+    mappedHaskell (ResolvedOpaque declaration) = (.haskell) declaration     timeImports =       Set.singleton "Data.Time.Clock (UTCTime)"  aggregateSourceReferences :: AggregateHaskellSource -> Set HaskellReference-aggregateSourceReferences source = maybe Set.empty Set.singleton (aggregateSourceReference source)+aggregateSourceReferences source = maybe Set.empty Set.singleton ((.reference) source) +aggregateSourceStaticImports :: AggregateHaskellSource -> Set Text+aggregateSourceStaticImports = (.staticImports)+ renderAggregateHaskellSource :: HaskellImportPlan -> AggregateHaskellSource -> Either HaskellImportError Text-renderAggregateHaskellSource plan source = case (aggregateSourceBuiltin source, aggregateSourceReference source) of+renderAggregateHaskellSource plan source = case ((.builtin) source, (.reference) source) of   (Just builtin, Nothing) -> pure builtin   (Nothing, Just reference) -> renderPlannedReference plan reference   _ -> error "invalid aggregate Haskell source description"@@ -288,45 +291,45 @@ aggregatePackages :: AggregateSymbols -> ResolvedAggregateType -> Set Text aggregatePackages symbols resolved = case resolved of   AggregateTime -> Set.singleton "time"-  AggregateNominal nominal -> case resolvedNominalOwnership nominal of+  AggregateNominal nominal -> case (.ownership) nominal of     GeneratedNominal -> Set.empty-    ConsumerNominal binding -> Set.singleton (hsPackage (consumerNominalHaskell binding))-  AggregateMapped key -> case Map.lookup key (symbolMapped symbols) of-    Just declaration -> Set.singleton (hsPackage (mappedHaskell declaration))+    ConsumerNominal binding -> Set.singleton ((.package) ((.haskell) binding))+  AggregateMapped key -> case Map.lookup key ((.mapped) symbols) of+    Just declaration -> Set.singleton ((.package) (mappedHaskell declaration))     Nothing -> Set.empty   _ -> Set.empty   where-    mappedHaskell (ResolvedStructural declaration _) = sdHaskell declaration-    mappedHaskell (ResolvedOpaque declaration) = odHaskell declaration+    mappedHaskell (ResolvedStructural declaration _) = (.haskell) declaration+    mappedHaskell (ResolvedOpaque declaration) = (.haskell) declaration  aggregateSampleHaskell :: AggregateSymbols -> Text -> ResolvedAggregateType -> Text-aggregateSampleHaskell symbols fieldName resolved = case resolved of-  AggregateText -> tshow ("sample-" <> fieldName)+aggregateSampleHaskell symbols sampleName resolved = case resolved of+  AggregateText -> tshow ("sample-" <> sampleName)   AggregateInt -> "0"   AggregateInteger -> "0"   AggregateBool -> "False"   AggregateTime -> "(UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012))"   AggregateNatural -> "0"   AggregateNominal nominal -> nominalSample nominal-  AggregateVertex name -> firstConstructor name-  AggregateMapped key -> case Map.lookup key (symbolMapped symbols) of+  AggregateVertex vertexName -> firstConstructor vertexName+  AggregateMapped key -> case Map.lookup key ((.mapped) symbols) of     Just declaration -> "(snd (NonEmpty.head (fixtureCases " <> unQualifiedValueName (mappedFixtures declaration) <> ")))"     Nothing -> unMappedKey key <> ".sample"   where-    firstConstructor name = case Map.lookup name (symbolVertices symbols) of+    firstConstructor vertexName = case Map.lookup vertexName ((.vertices) symbols) of       Just (constructor : _) -> constructor-      _ -> name-    nominalSample nominal = case resolvedNominalOwnership nominal of+      _ -> vertexName+    nominalSample nominal = case (.ownership) nominal of       ConsumerNominal binding ->         "(nominalFixtureDomain (NonEmpty.head (nominalFixtureCases "-          <> unQualifiedValueName (consumerNominalFixtures binding)+          <> unQualifiedValueName ((.fixtures) binding)           <> ")))"-      GeneratedNominal -> case resolvedNominalRepresentation nominal of-        IdRepresentation {} -> "(" <> resolvedNominalName nominal <> " \"sample\")"+      GeneratedNominal -> case (.representation) nominal of+        IdRepresentation {} -> "(" <> (.name) nominal <> " \"sample\")"         EnumRepresentation constructors -> fst (NE.head constructors)-        ScalarRepresentation {} -> resolvedNominalName nominal <> ".sample"-    mappedFixtures (ResolvedStructural declaration _) = sdFixtures declaration-    mappedFixtures (ResolvedOpaque declaration) = odFixtures declaration+        ScalarRepresentation {} -> (.name) nominal <> ".sample"+    mappedFixtures (ResolvedStructural declaration _) = (.fixtures) declaration+    mappedFixtures (ResolvedOpaque declaration) = (.fixtures) declaration  data ResolvedRegisterInitial   = InitialText !Text@@ -364,21 +367,21 @@       Just number | number >= 0 -> pure (InitialNatural (fromInteger number))       _ -> invalid "Natural initials must be non-negative integral literals"     RegInitText _ -> invalid "Natural initials must be unquoted non-negative integral literals"-  AggregateNominal nominal -> case resolvedNominalOwnership nominal of+  AggregateNominal nominal -> case (.ownership) nominal of     ConsumerNominal binding -> case syntax of-      RegInitBare "initial" -> case consumerNominalInitial binding of-        Just value -> pure (InitialNominal (resolvedNominalName nominal) value)+      RegInitBare "initial" -> case (.initial) binding of+        Just value -> pure (InitialNominal ((.name) nominal) value)         Nothing -> invalid "consumer-owned nominal register type must declare an initial symbol"       _ -> invalid "consumer-owned nominal register initials must use the bare initial token"-    GeneratedNominal -> case resolvedNominalRepresentation nominal of+    GeneratedNominal -> case (.representation) nominal of       IdRepresentation {} -> case syntax of-        RegInitBare "placeholder" -> pure (InitialId (resolvedNominalName nominal))+        RegInitBare "placeholder" -> pure (InitialId ((.name) nominal))         _ -> invalid "ID initials must use placeholder"-      EnumRepresentation constructors -> namedInitial (resolvedNominalName nominal) (Just (map fst (NE.toList constructors)))+      EnumRepresentation constructors -> namedInitial ((.name) nominal) (Just (map fst (NE.toList constructors)))       ScalarRepresentation {} -> invalid "generated nominal scalars are unsupported"-  AggregateVertex name -> namedInitial name (Map.lookup name (symbolVertices symbols))+  AggregateVertex name -> namedInitial name (Map.lookup name ((.vertices) symbols))   AggregateMapped key -> case syntax of-    RegInitBare "initial" -> case Map.lookup key (symbolMapped symbols) >>= mappedInitial of+    RegInitBare "initial" -> case Map.lookup key ((.mapped) symbols) >>= mappedInitial of       Just value -> pure (InitialMapped key value)       Nothing -> invalid "mapped register type must declare an initial symbol"     _ -> invalid "mapped register initials must use the bare initial token"@@ -387,8 +390,8 @@     namedInitial name constructors = case syntax of       RegInitBare constructor | maybe False (constructor `elem`) constructors -> pure (InitialNamed resolved constructor)       _ -> invalid ("initial must name a constructor of " <> name)-    mappedInitial (ResolvedStructural declaration _) = sdInitial declaration-    mappedInitial (ResolvedOpaque declaration) = odInitial declaration+    mappedInitial (ResolvedStructural declaration _) = (.initial) declaration+    mappedInitial (ResolvedOpaque declaration) = (.initial) declaration  renderRegisterInitial :: ResolvedRegisterInitial -> Text renderRegisterInitial initial = case initial of@@ -432,15 +435,15 @@ pascal :: Text -> Text pascal value =   case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-    Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)+    Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)     Left _ -> value   where     site =       HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedTypeSite,-          HaskellName.siteLogicalName = value,-          HaskellName.siteOwner = "aggregate-type",-          HaskellName.siteLine = 0+        { HaskellName.kind = HaskellName.GeneratedTypeSite,+          HaskellName.logicalName = value,+          HaskellName.owner = "aggregate-type",+          HaskellName.line = 0         }  tshow :: Text -> Text

src/Keiro/Dsl/BehaviorCoverage.hs view

@@ -7,6 +7,7 @@ -- consumer contract reconciles and executes witness values in a later layer. module Keiro.Dsl.BehaviorCoverage   ( BehaviorKey (..),+    unBehaviorKey,     ObligationKind (..),     EvidenceLevel (..),     GuardCoverage (..),@@ -50,6 +51,9 @@ newtype BehaviorKey = BehaviorKey {unBehaviorKey :: Text}   deriving stock (Eq, Ord, Show) +unBehaviorKey :: BehaviorKey -> Text+unBehaviorKey (BehaviorKey value) = value+ data ObligationKind   = LiveTransition   | RequiredRejection@@ -85,31 +89,31 @@ -- | Current exact presentation data attached only by a source-aware reporting -- path. It never contributes to 'requirementCanonical' or 'BehaviorKey'. data BehaviorExactLocation = BehaviorExactLocation-  { exactSourceFile :: !FilePath,-    exactSourceLine :: !Int,-    exactSourceColumn :: !Int+  { sourceFile :: !FilePath,+    sourceLine :: !Int,+    sourceColumn :: !Int   }   deriving stock (Eq, Ord, Show)  data BehaviorRequirement = BehaviorRequirement-  { requirementKey :: !BehaviorKey,-    requirementOrigin :: !RequirementOrigin,-    requirementKind :: !ObligationKind,-    requirementEvidence :: !EvidenceLevel,-    requirementGuardCoverage :: !GuardCoverage,-    requirementContext :: !Name,-    requirementAggregate :: !Name,-    requirementSource :: !Name,-    requirementCommand :: !Name,-    requirementTarget :: !(Maybe Name),-    requirementMode :: !(Maybe TransitionMode),-    requirementEvents :: ![Name],-    requirementOutputs :: ![OutputEvidence],-    requirementDomainOutcome :: !(Maybe TransitionOutcome),-    requirementLocation :: !Loc,-    requirementExactLocation :: !(Maybe BehaviorExactLocation),-    requirementOwner :: !(Maybe FilePath),-    requirementCanonical :: !Text+  { key :: !BehaviorKey,+    origin :: !RequirementOrigin,+    kind :: !ObligationKind,+    evidence :: !EvidenceLevel,+    guardCoverage :: !GuardCoverage,+    context :: !Name,+    aggregate :: !Name,+    source :: !Name,+    command :: !Name,+    target :: !(Maybe Name),+    mode :: !(Maybe TransitionMode),+    events :: ![Name],+    outputs :: ![OutputEvidence],+    domainOutcome :: !(Maybe TransitionOutcome),+    location :: !Loc,+    exactLocation :: !(Maybe BehaviorExactLocation),+    owner :: !(Maybe FilePath),+    canonical :: !Text   }   deriving stock (Eq, Show) @@ -117,14 +121,14 @@ -- retain enough human-readable identity to report additions and removals -- without re-reading or attempting to understand consumer Haskell. data BehaviorRecordRow = BehaviorRecordRow-  { behaviorRecordKey :: !BehaviorKey,-    behaviorRecordKind :: !ObligationKind,-    behaviorRecordEvidence :: !EvidenceLevel,-    behaviorRecordAggregate :: !Name,-    behaviorRecordSource :: !Name,-    behaviorRecordCommand :: !Name,-    behaviorRecordOwner :: !(Maybe FilePath),-    behaviorRecordOutputs :: ![OutputEvidence]+  { key :: !BehaviorKey,+    kind :: !ObligationKind,+    evidence :: !EvidenceLevel,+    aggregate :: !Name,+    source :: !Name,+    command :: !Name,+    owner :: !(Maybe FilePath),+    outputs :: ![OutputEvidence]   }   deriving stock (Eq, Ord, Show) @@ -136,9 +140,9 @@   deriving stock (Eq, Show)  data BehaviorObligationsReport = BehaviorObligationsReport-  { behaviorSubject :: !FilePath,-    behaviorWorkspaceService :: !(Maybe Text),-    behaviorRequirements :: ![BehaviorRequirement]+  { subject :: !FilePath,+    workspaceService :: !(Maybe Text),+    requirements :: ![BehaviorRequirement]   }   deriving stock (Eq, Show) @@ -189,15 +193,15 @@ instance ToJSON BehaviorRecordRow where   toJSON row =     object-      ( [ "key" .= behaviorRecordKey row,-          "kind" .= behaviorRecordKind row,-          "evidence" .= behaviorRecordEvidence row,-          "aggregate" .= behaviorRecordAggregate row,-          "source" .= behaviorRecordSource row,-          "command" .= behaviorRecordCommand row,-          "outputs" .= behaviorRecordOutputs row+      ( [ "key" .= (.key) row,+          "kind" .= (.kind) row,+          "evidence" .= (.evidence) row,+          "aggregate" .= (.aggregate) row,+          "source" .= (.source) row,+          "command" .= (.command) row,+          "outputs" .= (.outputs) row         ]-          <> ["owner" .= owner | Just owner <- [behaviorRecordOwner row]]+          <> ["owner" .= owner | Just owner <- [(.owner) row]]       )  instance FromJSON BehaviorRecordRow where@@ -215,38 +219,38 @@ instance ToJSON BehaviorRequirement where   toJSON requirement =     object-      ( [ "key" .= requirementKey requirement,-          "kind" .= requirementKind requirement,-          "evidence" .= requirementEvidence requirement,-          "guardCoverage" .= requirementGuardCoverage requirement,-          "context" .= requirementContext requirement,-          "aggregate" .= requirementAggregate requirement,-          "source" .= requirementSource requirement,-          "command" .= requirementCommand requirement,-          "target" .= requirementTarget requirement,-          "mode" .= fmap transitionModeText (requirementMode requirement),-          "events" .= requirementEvents requirement,-          "outputs" .= requirementOutputs requirement,+      ( [ "key" .= (.key) requirement,+          "kind" .= (.kind) requirement,+          "evidence" .= (.evidence) requirement,+          "guardCoverage" .= (.guardCoverage) requirement,+          "context" .= (.context) requirement,+          "aggregate" .= (.aggregate) requirement,+          "source" .= (.source) requirement,+          "command" .= (.command) requirement,+          "target" .= (.target) requirement,+          "mode" .= fmap transitionModeText ((.mode) requirement),+          "events" .= (.events) requirement,+          "outputs" .= (.outputs) requirement,           "location"             .= object-              ( ["line" .= maybe (unLoc (requirementLocation requirement)) exactSourceLine (requirementExactLocation requirement)]-                  <> ["member" .= owner | Just owner <- [requirementOwner requirement]]-                  <> ["file" .= exactSourceFile exact | Just exact <- [requirementExactLocation requirement]]-                  <> ["column" .= exactSourceColumn exact | Just exact <- [requirementExactLocation requirement]]-                  <> ["quality" .= maybe ("line-only" :: Text) (const "exact") (requirementExactLocation requirement)]+              ( ["line" .= maybe (unLoc ((.location) requirement)) (.sourceLine) ((.exactLocation) requirement)]+                  <> ["member" .= owner | Just owner <- [(.owner) requirement]]+                  <> ["file" .= (.sourceFile) exact | Just exact <- [(.exactLocation) requirement]]+                  <> ["column" .= (.sourceColumn) exact | Just exact <- [(.exactLocation) requirement]]+                  <> ["quality" .= maybe ("line-only" :: Text) (const "exact") ((.exactLocation) requirement)]               )         ]-          <> ["domainOutcome" .= canonicalTransitionOutcome (Just outcome) | Just outcome <- [requirementDomainOutcome requirement]]+          <> ["domainOutcome" .= canonicalTransitionOutcome (Just outcome) | Just outcome <- [(.domainOutcome) requirement]]       )  instance ToJSON BehaviorObligationsReport where   toJSON report =     object       ( [ "schema" .= ("keiro-dsl/behavior-obligations/1" :: Text),-          "subject" .= behaviorSubject report,-          "requirements" .= behaviorRequirements report+          "subject" .= (.subject) report,+          "requirements" .= (.requirements) report         ]-          <> ["workspace" .= object ["service" .= service] | Just service <- [behaviorWorkspaceService report]]+          <> ["workspace" .= object ["service" .= service] | Just service <- [(.workspaceService) report]]       )  deriveBehaviorRequirements :: Spec -> Either [BehaviorDerivationError] [BehaviorRequirement]@@ -261,9 +265,9 @@   Left derivationError -> Left [derivationError]   Right raw -> do     rejectIdentityDefects raw-    pure (sortOn requirementKey raw)+    pure (sortOn (.key) raw)   where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]  deriveAggregateBehaviorRequirements :: Spec -> Aggregate -> Either BehaviorDerivationError [BehaviorRequirement] deriveAggregateBehaviorRequirements spec = deriveAggregateBehaviorRequirementsWithGraphResult (resolveTypeGraph spec) spec@@ -271,21 +275,21 @@ deriveAggregateBehaviorRequirementsWithGraphResult :: Either (NonEmpty TypeGraphError) TypeGraph -> Spec -> Aggregate -> Either BehaviorDerivationError [BehaviorRequirement] deriveAggregateBehaviorRequirementsWithGraphResult typeGraphResult spec aggregate = do   let reachable = liveReachableStates aggregate-      indexedTransitions = zip (map TransitionOrdinal [0 ..]) (aggTransitions aggregate)+      indexedTransitions = zip (map TransitionOrdinal [0 ..]) ((.transitions) aggregate)       liveTransitions =         [ (ordinal, transition)         | (ordinal, transition) <- indexedTransitions,-          tMode transition == TmLive,-          tSource transition `Set.member` reachable+          (.mode) transition == TmLive,+          (.source) transition `Set.member` reachable         ]-      replayTransitions = [(ordinal, transition) | (ordinal, transition) <- indexedTransitions, tMode transition == TmReplayOnly]-      commands = map cmdName (aggCommands aggregate)-      cells = [(state, command) | state <- Set.toAscList reachable, command <- commands]-      cellTransitions state command =+      replayTransitions = [(ordinal, transition) | (ordinal, transition) <- indexedTransitions, (.mode) transition == TmReplayOnly]+      commands = map (\command -> command.name) ((.commands) aggregate)+      cells = [(state, commandName) | state <- Set.toAscList reachable, commandName <- commands]+      cellTransitions state commandName =         [ (ordinal, transition)         | (ordinal, transition) <- liveTransitions,-          tSource transition == state,-          tCommand transition == command+          (.source) transition == state,+          (.command) transition == commandName         ]       transitionRows =         [ transitionRequirement typeGraphResult spec aggregate (cellGuardCoverage (map snd siblings)) ordinal transition@@ -306,19 +310,38 @@   where     toRow requirement =       BehaviorRecordRow-        { behaviorRecordKey = requirementKey requirement,-          behaviorRecordKind = requirementKind requirement,-          behaviorRecordEvidence = requirementEvidence requirement,-          behaviorRecordAggregate = requirementAggregate requirement,-          behaviorRecordSource = requirementSource requirement,-          behaviorRecordCommand = requirementCommand requirement,-          behaviorRecordOwner = requirementOwner requirement,-          behaviorRecordOutputs = requirementOutputs requirement+        { key = (.key) requirement,+          kind = (.kind) requirement,+          evidence = (.evidence) requirement,+          aggregate = (.aggregate) requirement,+          source = (.source) requirement,+          command = (.command) requirement,+          owner = (.owner) requirement,+          outputs = (.outputs) requirement         }  attributeBehaviorOwner :: (Name -> Maybe FilePath) -> BehaviorRequirement -> BehaviorRequirement-attributeBehaviorOwner ownerForAggregate requirement =-  requirement {requirementOwner = ownerForAggregate (requirementAggregate requirement)}+attributeBehaviorOwner ownerForAggregate BehaviorRequirement {key, origin, kind, evidence, guardCoverage, context, aggregate, source, command, target, mode, events, outputs, domainOutcome, location, exactLocation, canonical} =+  BehaviorRequirement+    { key,+      origin,+      kind,+      evidence,+      guardCoverage,+      context,+      aggregate,+      source,+      command,+      target,+      mode,+      events,+      outputs,+      domainOutcome,+      location,+      exactLocation,+      owner = ownerForAggregate aggregate,+      canonical+    }  behaviorObligationsReport :: FilePath -> Spec -> Either [BehaviorDerivationError] BehaviorObligationsReport behaviorObligationsReport subject spec =@@ -326,59 +349,59 @@  transitionRequirement :: Either (NonEmpty TypeGraphError) TypeGraph -> Spec -> Aggregate -> GuardCoverage -> TransitionOrdinal -> Transition -> Either BehaviorDerivationError BehaviorRequirement transitionRequirement typeGraphResult spec aggregate guardCoverage ordinal transition = do-  if null (tEmits transition) && (tSource transition /= tGoto transition || not (null (tWrites transition)))-    then Left (EventlessStateChange (aggName aggregate) (tSource transition) (tCommand transition))+  if null ((.emits) transition) && ((.source) transition /= (.goto) transition || not (null ((.writes) transition)))+    then Left (EventlessStateChange ((.name) aggregate) ((.source) transition) ((.command) transition))     else pure ()   mappings <-     traverse       (\(emitIndex, eventName) -> either (Left . InvalidEventOutput eventName) Right (eventOutputMappingFromGraphResult typeGraphResult spec aggregate transition emitIndex eventName))-      (zip [1 ..] (tEmits transition))-  let kind = if tMode transition == TmLive then LiveTransition else ReplayTransition+      (zip [1 ..] ((.emits) transition))+  let kind = if (.mode) transition == TmLive then LiveTransition else ReplayTransition       outputs = map outputEvidence mappings       canonical = transitionCanonical spec aggregate kind transition mappings   pure     BehaviorRequirement-      { requirementKey = canonicalKey canonical,-        requirementOrigin = TransitionRequirementOrigin (aggName aggregate) ordinal,-        requirementKind = kind,-        requirementEvidence = transitionEvidence transition,-        requirementGuardCoverage = guardCoverage,-        requirementContext = specContext spec,-        requirementAggregate = aggName aggregate,-        requirementSource = tSource transition,-        requirementCommand = tCommand transition,-        requirementTarget = Just (tGoto transition),-        requirementMode = Just (tMode transition),-        requirementEvents = tEmits transition,-        requirementOutputs = outputs,-        requirementDomainOutcome = tOutcome transition,-        requirementLocation = tLoc transition,-        requirementExactLocation = Nothing,-        requirementOwner = Nothing,-        requirementCanonical = canonical+      { key = canonicalKey canonical,+        origin = TransitionRequirementOrigin ((.name) aggregate) ordinal,+        kind = kind,+        evidence = transitionEvidence transition,+        guardCoverage = guardCoverage,+        context = (.context) spec,+        aggregate = (.name) aggregate,+        source = (.source) transition,+        command = (.command) transition,+        target = Just ((.goto) transition),+        mode = Just ((.mode) transition),+        events = (.emits) transition,+        outputs = outputs,+        domainOutcome = (.outcome) transition,+        location = (.loc) transition,+        exactLocation = Nothing,+        owner = Nothing,+        canonical = canonical       }  rejectionRequirement :: Spec -> Aggregate -> Name -> Name -> BehaviorRequirement rejectionRequirement spec aggregate state command =   BehaviorRequirement-    { requirementKey = canonicalKey canonical,-      requirementOrigin = RejectionRequirementOrigin (aggName aggregate) state,-      requirementKind = RequiredRejection,-      requirementEvidence = aggregateEvidence aggregate,-      requirementGuardCoverage = GuardNotApplicable,-      requirementContext = specContext spec,-      requirementAggregate = aggName aggregate,-      requirementSource = state,-      requirementCommand = command,-      requirementTarget = Nothing,-      requirementMode = Nothing,-      requirementEvents = [],-      requirementOutputs = [],-      requirementDomainOutcome = Nothing,-      requirementLocation = maybe (aggLoc aggregate) stLoc (find ((== state) . stName) (aggStates aggregate)),-      requirementExactLocation = Nothing,-      requirementOwner = Nothing,-      requirementCanonical = canonical+    { key = canonicalKey canonical,+      origin = RejectionRequirementOrigin ((.name) aggregate) state,+      kind = RequiredRejection,+      evidence = aggregateEvidence aggregate,+      guardCoverage = GuardNotApplicable,+      context = (.context) spec,+      aggregate = (.name) aggregate,+      source = state,+      command = command,+      target = Nothing,+      mode = Nothing,+      events = [],+      outputs = [],+      domainOutcome = Nothing,+      location = maybe ((.loc) aggregate) (.loc) (find ((== state) . (.name)) ((.states) aggregate)),+      exactLocation = Nothing,+      owner = Nothing,+      canonical = canonical     }   where     canonical =@@ -386,8 +409,8 @@         "|"         [ "behavior-v1",           "kind=rejection",-          "context=" <> specContext spec,-          "aggregate=" <> aggName aggregate,+          "context=" <> (.context) spec,+          "aggregate=" <> (.name) aggregate,           "source=" <> state,           "command=" <> command         ]@@ -398,27 +421,27 @@     "|"     ( [ "behavior-v1",         "kind=" <> obligationKindText kind,-        "context=" <> specContext spec,-        "aggregate=" <> aggName aggregate,-        "mode=" <> transitionModeText (tMode transition),-        "source=" <> tSource transition,-        "command=" <> tCommand transition,-        "implementation=" <> implementationText (tImplementation transition),-        "guard=" <> maybe "" renderExpr (tGuard transition),-        "writes=" <> T.intercalate ";" [name <> ":=" <> renderExpr expression | (name, expression) <- tWrites transition],-        "events=" <> T.intercalate "," (tEmits transition),+        "context=" <> (.context) spec,+        "aggregate=" <> (.name) aggregate,+        "mode=" <> transitionModeText ((.mode) transition),+        "source=" <> (.source) transition,+        "command=" <> (.command) transition,+        "implementation=" <> implementationText ((.implementation) transition),+        "guard=" <> maybe "" renderExpr ((.guard) transition),+        "writes=" <> T.intercalate ";" [name <> ":=" <> renderExpr expression | (name, expression) <- (.writes) transition],+        "events=" <> T.intercalate "," ((.emits) transition),         "outputs=" <> T.intercalate "," (map eventOutputCanonical mappings),-        "target=" <> tGoto transition+        "target=" <> (.goto) transition       ]         ++ outcomeSegments     )   where-    outcomeSegments = case aggDomainOutcomeTypes aggregate of+    outcomeSegments = case (.domainOutcomeTypes) aggregate of       Nothing -> []       Just declaration ->-        [ "outcome-rejection-type=" <> rejectionType declaration,-          "outcome-no-op-type=" <> noOpType declaration,-          "domain-outcome=" <> canonicalTransitionOutcome (tOutcome transition)+        [ "outcome-rejection-type=" <> (.rejectionType) declaration,+          "outcome-no-op-type=" <> (.noOpType) declaration,+          "domain-outcome=" <> canonicalTransitionOutcome ((.outcome) transition)         ]  canonicalKey :: Text -> BehaviorKey@@ -430,25 +453,25 @@   HandOwnedEventOutput obligation -> HandOwnedOutput obligation  transitionEvidence :: Transition -> EvidenceLevel-transitionEvidence transition = case tImplementation transition of+transitionEvidence transition = case (.implementation) transition of   LegacyHoleImplementation -> LegacyRuntimeWitness   GeneratedImplementation -> GeneratedAuthoritative   HoleImplementation -> HoleWitnessed  aggregateEvidence :: Aggregate -> EvidenceLevel aggregateEvidence aggregate-  | any ((/= LegacyHoleImplementation) . tImplementation) (aggTransitions aggregate) = GeneratedAuthoritative+  | any ((/= LegacyHoleImplementation) . (.implementation)) ((.transitions) aggregate) = GeneratedAuthoritative   | otherwise = LegacyRuntimeWitness  cellGuardCoverage :: [Transition] -> GuardCoverage cellGuardCoverage transitions-  | any ((== Nothing) . tGuard) transitions = GuardTotal+  | any ((== Nothing) . (.guard)) transitions = GuardTotal   | any crossesOneWayProjection guards = GuardUnknown   | complementary = GuardTotal   | all isLiteralFalse guards = GuardPartial   | otherwise = GuardUnknown   where-    guards = [guard | transition <- transitions, Just guard <- [tGuard transition]]+    guards = [guard | transition <- transitions, Just guard <- [(.guard) transition]]     complementary = or [left == complementExpr right | left <- guards, right <- guards, left /= right]     isLiteralFalse (EAtom (ABool False)) = True     isLiteralFalse _ = False@@ -468,22 +491,22 @@  replayGuardCoverage :: Transition -> GuardCoverage replayGuardCoverage transition-  | maybe False crossesOneWayProjection (tGuard transition) = GuardUnknown+  | maybe False crossesOneWayProjection ((.guard) transition) = GuardUnknown   | otherwise = GuardNotApplicable  liveReachableStates :: Aggregate -> Set Name-liveReachableStates aggregate = case map stName (aggStates aggregate) of+liveReachableStates aggregate = case map (\state -> state.name) ((.states) aggregate) of   [] -> Set.empty   initial : _ -> go (Set.singleton initial) [initial]   where     go seen [] = seen     go seen (source : remaining) =       let next =-            [ tGoto transition-            | transition <- aggTransitions aggregate,-              tMode transition == TmLive,-              tSource transition == source,-              tGoto transition `Set.notMember` seen+            [ (.goto) transition+            | transition <- (.transitions) aggregate,+              (.mode) transition == TmLive,+              (.source) transition == source,+              (.goto) transition `Set.notMember` seen             ]        in go (foldr Set.insert seen next) (remaining <> next) @@ -492,18 +515,18 @@   [] -> Right ()   errors -> Left errors   where-    byCanonical = groupsOn requirementCanonical requirements+    byCanonical = groupsOn (.canonical) requirements     duplicateErrors =-      [ DuplicateBehaviorIdentity canonical (map requirementLocation duplicates)+      [ DuplicateBehaviorIdentity canonicalIdentity (map (\requirement -> requirement.location) duplicates)       | duplicates@(first : _ : _) <- byCanonical,-        let canonical = requirementCanonical first+        let canonicalIdentity = (.canonical) first       ]-    byKey = groupsOn requirementKey requirements+    byKey = groupsOn (.key) requirements     collisionErrors =-      [ BehaviorKeyCollision key canonicals+      [ BehaviorKeyCollision behaviorKey canonicals       | collisions@(first : _ : _) <- byKey,-        let key = requirementKey first,-        let canonicals = Set.toAscList (Set.fromList (map requirementCanonical collisions)),+        let behaviorKey = (.key) first,+        let canonicals = Set.toAscList (Set.fromList (map (\requirement -> requirement.canonical) collisions)),         length canonicals > 1       ] @@ -513,40 +536,40 @@ renderBehaviorObligationsText :: BehaviorObligationsReport -> Text renderBehaviorObligationsText report =   T.unlines-    ( [ "behavior obligations: " <> T.pack (behaviorSubject report),+    ( [ "behavior obligations: " <> T.pack ((.subject) report),         "schema: keiro-dsl/behavior-obligations/1",-        "required: " <> tshow (length (behaviorRequirements report))+        "required: " <> tshow (length ((.requirements) report))       ]-        <> map renderRequirement (behaviorRequirements report)+        <> map renderRequirement ((.requirements) report)     )   where     renderRequirement requirement =-      unBehaviorKey (requirementKey requirement)+      unBehaviorKey ((.key) requirement)         <> " "-        <> obligationKindText (requirementKind requirement)+        <> obligationKindText ((.kind) requirement)         <> " "-        <> requirementAggregate requirement+        <> (.aggregate) requirement         <> ":"-        <> requirementSource requirement+        <> (.source) requirement         <> " -- "-        <> requirementCommand requirement+        <> (.command) requirement         <> " ["-        <> evidenceLevelText (requirementEvidence requirement)+        <> evidenceLevelText ((.evidence) requirement)         <> ", guard="-        <> guardCoverageText (requirementGuardCoverage requirement)+        <> guardCoverageText ((.guardCoverage) requirement)         <> "]"-        <> maybe (renderLineOnly requirement) renderExact (requirementExactLocation requirement)+        <> maybe (renderLineOnly requirement) renderExact ((.exactLocation) requirement)     renderExact exact =       " "-        <> T.pack (exactSourceFile exact)+        <> T.pack ((.sourceFile) exact)         <> ":"-        <> tshow (exactSourceLine exact)+        <> tshow ((.sourceLine) exact)         <> ":"-        <> tshow (exactSourceColumn exact)+        <> tshow ((.sourceColumn) exact)         <> " [location-quality=exact]"     renderLineOnly requirement =       " line "-        <> tshow (unLoc (requirementLocation requirement))+        <> tshow (unLoc ((.location) requirement))         <> " [location-quality=line-only]"  encodeBehaviorObligationsJson :: BehaviorObligationsReport -> Text

src/Keiro/Dsl/BehaviorSourceMap.hs view

@@ -17,15 +17,8 @@ import Keiro.Dsl.BehaviorCoverage   ( BehaviorExactLocation (..),     BehaviorKey,-    BehaviorRequirement,+    BehaviorRequirement (..),     RequirementOrigin (..),-    requirementAggregate,-    requirementCanonical,-    requirementCommand,-    requirementExactLocation,-    requirementKey,-    requirementOrigin,-    requirementSource,   ) import Keiro.Dsl.Source (SourcePoint (..), SourceSpan (..)) import Keiro.Dsl.SourceIndex@@ -42,23 +35,23 @@   deriving stock (Eq, Ord, Show)  data BehaviorSourceFailure = BehaviorSourceFailure-  { failureCode :: !BehaviorSourceFailureCode,-    failureKey :: !BehaviorKey,-    failureOrigin :: !RequirementOrigin,-    failureAggregate :: !Text,-    failureState :: !Text,-    failureCommand :: !Text,-    failureSourceSubject :: !SourceSubject,-    failureSpan :: !(Maybe SourceSpan),-    failureMessage :: !Text+  { code :: !BehaviorSourceFailureCode,+    key :: !BehaviorKey,+    origin :: !RequirementOrigin,+    aggregate :: !Text,+    state :: !Text,+    command :: !Text,+    sourceSubject :: !SourceSubject,+    span :: !(Maybe SourceSpan),+    message :: !Text   }   deriving stock (Eq, Show)  data BehaviorSourceEntry = BehaviorSourceEntry-  { behaviorSourceKey :: !BehaviorKey,-    behaviorSourceFile :: !FilePath,-    behaviorSourceLine :: !Int,-    behaviorSourceColumn :: !Int+  { key :: !BehaviorKey,+    file :: !FilePath,+    line :: !Int,+    column :: !Int   }   deriving stock (Eq, Ord, Show) @@ -76,44 +69,44 @@       | otherwise -> Left (missingJoinFailures requirementKeys entryKeys)     failures -> Left (sortOn failureSortKey failures)   where-    duplicateFailures = concatMap duplicateKeyFailure (groupsOn requirementKey requirements)+    duplicateFailures = concatMap duplicateKeyFailure (groupsOn (.key) requirements)     duplicateKeyFailure duplicates@(first : _ : _) =       [ BehaviorSourceFailure-          { failureCode = BehaviorSourceAnchorCollision,-            failureKey = requirementKey first,-            failureOrigin = requirementOrigin first,-            failureAggregate = requirementAggregate first,-            failureState = requirementSource first,-            failureCommand = requirementCommand first,-            failureSourceSubject = requirementSourceSubject (requirementOrigin first),-            failureSpan = Nothing,-            failureMessage =-              if Set.size (Set.fromList (map requirementCanonical duplicates)) > 1+          { code = BehaviorSourceAnchorCollision,+            key = (.key) first,+            origin = (.origin) first,+            aggregate = (.aggregate) first,+            state = (.source) first,+            command = (.command) first,+            sourceSubject = requirementSourceSubject ((.origin) first),+            span = Nothing,+            message =+              if Set.size (Set.fromList (map (.canonical) duplicates)) > 1                 then "behavior key identifies more than one canonical obligation"                 else "behavior key occurs more than once in the requirement inventory"           }       ]     duplicateKeyFailure _ = []-    uniqueRequirements = [requirement | [requirement] <- groupsOn requirementKey requirements]+    uniqueRequirements = [requirement | [requirement] <- groupsOn (.key) requirements]     planned = map (planEntry sourceIndex) uniqueRequirements     anchorFailures = [failure | Left failure <- planned]-    sortedEntries = sortOn behaviorSourceKey [entry | Right entry <- planned]-    requirementKeys = Set.fromList (map requirementKey requirements)-    entryKeys = Set.fromList (map behaviorSourceKey sortedEntries)+    sortedEntries = sortOn (.key) [entry | Right entry <- planned]+    requirementKeys = Set.fromList (map (.key) requirements)+    entryKeys = Set.fromList (map (.key) sortedEntries)     missingJoinFailures expected actual =       [ BehaviorSourceFailure-          { failureCode = BehaviorSourceAnchorMissing,-            failureKey = requirementKey requirement,-            failureOrigin = requirementOrigin requirement,-            failureAggregate = requirementAggregate requirement,-            failureState = requirementSource requirement,-            failureCommand = requirementCommand requirement,-            failureSourceSubject = requirementSourceSubject (requirementOrigin requirement),-            failureSpan = Nothing,-            failureMessage = "behavior requirement is absent from the completed source-map join"+          { code = BehaviorSourceAnchorMissing,+            key = (.key) requirement,+            origin = (.origin) requirement,+            aggregate = (.aggregate) requirement,+            state = (.source) requirement,+            command = (.command) requirement,+            sourceSubject = requirementSourceSubject ((.origin) requirement),+            span = Nothing,+            message = "behavior requirement is absent from the completed source-map join"           }       | requirement <- requirements,-        requirementKey requirement `Set.member` (expected Set.\\ actual)+        (.key) requirement `Set.member` (expected Set.\\ actual)       ]  -- | Attach exact presentation data after a successful complete join. Unknown@@ -123,20 +116,42 @@ attachBehaviorSourceLocations :: [BehaviorSourceEntry] -> [BehaviorRequirement] -> [BehaviorRequirement] attachBehaviorSourceLocations entries = map attach   where-    byKey = Map.fromList [(behaviorSourceKey entry, entry) | entry <- entries]-    attach requirement = case Map.lookup (requirementKey requirement) byKey of+    byKey = Map.fromList [((.key) entry, entry) | entry <- entries]+    attach requirement = case Map.lookup ((.key) requirement) byKey of       Nothing -> requirement       Just entry ->-        requirement-          { requirementExactLocation =-              Just-                BehaviorExactLocation-                  { exactSourceFile = behaviorSourceFile entry,-                    exactSourceLine = behaviorSourceLine entry,-                    exactSourceColumn = behaviorSourceColumn entry-                  }-          }+        replaceRequirementExactLocation+          ( Just+              BehaviorExactLocation+                { sourceFile = entry.file,+                  sourceLine = entry.line,+                  sourceColumn = entry.column+                }+          )+          requirement +    replaceRequirementExactLocation exactLocation requirement =+      BehaviorRequirement+        { key = requirement.key,+          origin = requirement.origin,+          kind = requirement.kind,+          evidence = requirement.evidence,+          guardCoverage = requirement.guardCoverage,+          context = requirement.context,+          aggregate = requirement.aggregate,+          source = requirement.source,+          command = requirement.command,+          target = requirement.target,+          mode = requirement.mode,+          events = requirement.events,+          outputs = requirement.outputs,+          domainOutcome = requirement.domainOutcome,+          location = requirement.location,+          exactLocation,+          owner = requirement.owner,+          canonical = requirement.canonical+        }+ planEntry :: SemanticSourceIndex -> BehaviorRequirement -> Either BehaviorSourceFailure BehaviorSourceEntry planEntry sourceIndex requirement =   case lookupSourceSpan subject sourceIndex of@@ -146,24 +161,24 @@     Just (ExactSourcePosition, SourceSpan {source, start = SourcePoint {line, column}}) ->       Right         BehaviorSourceEntry-          { behaviorSourceKey = requirementKey requirement,-            behaviorSourceFile = source,-            behaviorSourceLine = line,-            behaviorSourceColumn = column+          { key = (.key) requirement,+            file = source,+            line = line,+            column = column           }   where-    subject = requirementSourceSubject (requirementOrigin requirement)-    failure failureCode failureSpan failureMessage =+    subject = requirementSourceSubject ((.origin) requirement)+    failure code sourceSpan message =       BehaviorSourceFailure-        { failureCode,-          failureKey = requirementKey requirement,-          failureOrigin = requirementOrigin requirement,-          failureAggregate = requirementAggregate requirement,-          failureState = requirementSource requirement,-          failureCommand = requirementCommand requirement,-          failureSourceSubject = subject,-          failureSpan,-          failureMessage+        { code,+          key = (.key) requirement,+          origin = (.origin) requirement,+          aggregate = (.aggregate) requirement,+          state = (.source) requirement,+          command = (.command) requirement,+          sourceSubject = subject,+          span = sourceSpan,+          message         }  requirementSourceSubject :: RequirementOrigin -> SourceSubject@@ -175,5 +190,5 @@ groupsOn key = groupBy (\left right -> key left == key right) . sortOn key  failureSortKey :: BehaviorSourceFailure -> (BehaviorSourceFailureCode, BehaviorKey, RequirementOrigin)-failureSortKey BehaviorSourceFailure {failureCode, failureKey, failureOrigin} =-  (failureCode, failureKey, failureOrigin)+failureSortKey BehaviorSourceFailure {code, key, origin} =+  (code, key, origin)

src/Keiro/Dsl/CanonicalEncoding.hs view

@@ -42,7 +42,7 @@ canonicalDomainOutcomeTypes :: Maybe DomainOutcomeTypes -> Text canonicalDomainOutcomeTypes Nothing = "" canonicalDomainOutcomeTypes (Just declaration) =-  "rejection=" <> rejectionType declaration <> "|no-op=" <> noOpType declaration+  "rejection=" <> (.rejectionType) declaration <> "|no-op=" <> (.noOpType) declaration  -- | Deterministic command-behavior identity for one transition outcome. It is -- excluded from persisted fold identity because it labels a selected edge@@ -101,18 +101,18 @@ docTransition :: Transition -> Doc ann docTransition transition =   vsep $-    [modePrefix <> pretty (tSource transition) <+> "--" <+> pretty (tCommand transition) <+> "-->"]+    [modePrefix <> pretty ((.source) transition) <+> "--" <+> pretty ((.command) transition) <+> "-->"]       ++ map (indent 2) clauses   where-    modePrefix = case tMode transition of+    modePrefix = case (.mode) transition of       TmLive -> mempty       TmReplayOnly -> "replay-only "     clauses =-      ["implementation hole" | tImplementation transition == HoleImplementation]-        ++ maybe [] (\guardExpression -> ["guard" <+> docExpr 0 guardExpression]) (tGuard transition)-        ++ map (\(registerName, expression) -> "write" <+> pretty registerName <+> ":=" <+> docExpr 0 expression) (tWrites transition)-        ++ map (\eventName -> "emit" <+> pretty eventName) (tEmits transition)-        ++ ["goto" <+> pretty (tGoto transition)]+      ["implementation hole" | (.implementation) transition == HoleImplementation]+        ++ maybe [] (\guardExpression -> ["guard" <+> docExpr 0 guardExpression]) ((.guard) transition)+        ++ map (\(registerName, expression) -> "write" <+> pretty registerName <+> ":=" <+> docExpr 0 expression) ((.writes) transition)+        ++ map (\eventName -> "emit" <+> pretty eventName) ((.emits) transition)+        ++ ["goto" <+> pretty ((.goto) transition)]  -- | @showsPrec@-style frozen expression encoding. Precedence levels are -- @||@ = 1, @&&@ = 2, comparisons = 3, addition/subtraction = 4,

src/Keiro/Dsl/CheckReport.hs view

@@ -33,56 +33,56 @@ import Data.Set qualified as Set import Data.Text (Text) import Keiro.Dsl.LanguageVersion (LanguageSupport (..), LanguageVersion, SourceLanguage, declaredLanguageVersionMaybe, languageSupportText, sourceFormText)-import Keiro.Dsl.SemanticContract (EffectiveLanguageContract, effectiveContractLanguageVersion, effectiveLanguageSupport, effectiveRuntimeSemantics)+import Keiro.Dsl.SemanticContract (EffectiveLanguageContract (..), effectiveLanguageSupport, effectiveRuntimeSemantics) import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode, Severity (..), diagnosticCodeText) import Keiro.Dsl.Workspace (WorkspaceDiagnostic (..), WorkspaceLocation (..), WorkspaceMember (..), WorkspaceSpec (..), workspaceDisplayPath)  data CheckReportLanguage = CheckReportLanguage-  { reportSourceForm :: !Text,-    reportDeclaredLanguageVersion :: !(Maybe LanguageVersion),-    reportEffectiveLanguageVersion :: !LanguageVersion,-    reportRuntimeSemantics :: !Text,-    reportLanguageSupport :: !LanguageSupport,-    reportStable :: !Bool+  { sourceForm :: !Text,+    declaredLanguageVersion :: !(Maybe LanguageVersion),+    effectiveLanguageVersion :: !LanguageVersion,+    runtimeSemantics :: !Text,+    languageSupport :: !LanguageSupport,+    stable :: !Bool   }   deriving stock (Eq, Show)  data CheckReportEnforcement = CheckReportEnforcement-  { reportMinLanguage :: !(Maybe LanguageVersion),-    reportDenyWarnings :: !Bool,-    reportDenyCodes :: ![DiagnosticCode]+  { minLanguage :: !(Maybe LanguageVersion),+    denyWarnings :: !Bool,+    denyCodes :: ![DiagnosticCode]   }   deriving stock (Eq, Show)  data CheckReportRelated = CheckReportRelated-  { relatedFile :: !FilePath,-    relatedLine :: !Int,-    relatedNote :: !Text+  { file :: !FilePath,+    line :: !Int,+    note :: !Text   }   deriving stock (Eq, Show)  data CheckReportEntry = CheckReportEntry-  { entryCode :: !DiagnosticCode,-    entrySeverity :: !Severity,-    entryFile :: !FilePath,-    entryLine :: !Int,-    entryMessage :: !Text,-    entryDenied :: !Bool,-    entryRelated :: ![CheckReportRelated]+  { code :: !DiagnosticCode,+    severity :: !Severity,+    file :: !FilePath,+    line :: !Int,+    message :: !Text,+    denied :: !Bool,+    related :: ![CheckReportRelated]   }   deriving stock (Eq, Show)  data CheckReportSummary = CheckReportSummary-  { summaryErrors :: !Int,-    summaryWarnings :: !Int,-    summaryDeniedWarnings :: !Int+  { errors :: !Int,+    warnings :: !Int,+    deniedWarnings :: !Int   }   deriving stock (Eq, Show)  data CheckReportMember = CheckReportMember-  { memberPath :: !FilePath,-    memberSourceForm :: !Text,-    memberDeclaredLanguageVersion :: !(Maybe LanguageVersion)+  { path :: !FilePath,+    sourceForm :: !Text,+    declaredLanguageVersion :: !(Maybe LanguageVersion)   }   deriving stock (Eq, Show) @@ -90,17 +90,17 @@   deriving stock (Eq, Show)  data CheckReport = CheckReport-  { reportKind :: !CheckReportKind,-    reportSubject :: !FilePath,+  { kind :: !CheckReportKind,+    subject :: !FilePath,     -- | 'Nothing' only for a workspace that was refused during composition:     -- there is no composed service, so no effective language contract exists to     -- describe. Such a report serializes @"language": null@.-    reportLanguage :: !(Maybe CheckReportLanguage),-    reportEnforcement :: !CheckReportEnforcement,-    reportDiagnostics :: ![CheckReportEntry],-    reportSummary :: !CheckReportSummary,-    reportOk :: !Bool,-    reportMembers :: ![CheckReportMember]+    language :: !(Maybe CheckReportLanguage),+    enforcement :: !CheckReportEnforcement,+    diagnostics :: ![CheckReportEntry],+    summary :: !CheckReportSummary,+    ok :: !Bool,+    members :: ![CheckReportMember]   }   deriving stock (Eq, Show) @@ -108,8 +108,8 @@ -- by report entries. @--deny-warnings@ is the union with every registered code. effectiveDenyCodes :: CheckReportEnforcement -> Set DiagnosticCode effectiveDenyCodes enforcement-  | reportDenyWarnings enforcement = Set.fromList [minBound .. maxBound]-  | otherwise = Set.fromList (reportDenyCodes enforcement)+  | (.denyWarnings) enforcement = Set.fromList [minBound .. maxBound]+  | otherwise = Set.fromList ((.denyCodes) enforcement)  checkReport ::   FilePath ->@@ -143,7 +143,7 @@     (Just (workspaceLanguageValue contract))     enforcement     (map (workspaceEntry subject deniedCodes) diagnostics)-    (map memberValue (wsMembers workspace))+    (map memberValue ((.members) workspace))  -- | The report for a workspace refused during composition, before any service -- graph exists. Composition refusals are coded diagnostics, so they belong in@@ -175,21 +175,21 @@   CheckReport buildReport kind subject language enforcement entries members =   CheckReport-    { reportKind = kind,-      reportSubject = subject,-      reportLanguage = language,-      reportEnforcement = enforcement,-      reportDiagnostics = entries,-      reportSummary = summary,-      reportOk = summaryErrors summary == 0 && summaryDeniedWarnings summary == 0,-      reportMembers = members+    { kind = kind,+      subject = subject,+      language = language,+      enforcement = enforcement,+      diagnostics = entries,+      summary = summary,+      ok = (.errors) summary == 0 && (.deniedWarnings) summary == 0,+      members = members     }   where     summary =       CheckReportSummary-        { summaryErrors = length [() | entry <- entries, entrySeverity entry == Error],-          summaryWarnings = length [() | entry <- entries, entrySeverity entry == Warning],-          summaryDeniedWarnings = length [() | entry <- entries, entryDenied entry]+        { errors = length [() | entry <- entries, (.severity) entry == Error],+          warnings = length [() | entry <- entries, (.severity) entry == Warning],+          deniedWarnings = length [() | entry <- entries, (.denied) entry]         }  sourceLanguageValue :: SourceLanguage -> EffectiveLanguageContract -> CheckReportLanguage@@ -205,12 +205,12 @@ languageValue :: Text -> Maybe LanguageVersion -> EffectiveLanguageContract -> CheckReportLanguage languageValue sourceForm declared contract =   CheckReportLanguage-    { reportSourceForm = sourceForm,-      reportDeclaredLanguageVersion = declared,-      reportEffectiveLanguageVersion = effectiveContractLanguageVersion contract,-      reportRuntimeSemantics = effectiveRuntimeSemantics contract,-      reportLanguageSupport = support,-      reportStable = support == Stable+    { sourceForm = sourceForm,+      declaredLanguageVersion = declared,+      effectiveLanguageVersion = (.contractLanguageVersion) contract,+      runtimeSemantics = effectiveRuntimeSemantics contract,+      languageSupport = support,+      stable = support == Stable     }   where     support = effectiveLanguageSupport contract@@ -218,45 +218,45 @@ memberValue :: WorkspaceMember -> CheckReportMember memberValue member =   CheckReportMember-    { memberPath = wmPath member,-      memberSourceForm = sourceFormText (wmSourceLanguage member),-      memberDeclaredLanguageVersion = declaredLanguageVersionMaybe (wmSourceLanguage member)+    { path = (.path) member,+      sourceForm = sourceFormText ((.sourceLanguage) member),+      declaredLanguageVersion = declaredLanguageVersionMaybe ((.sourceLanguage) member)     }  sourceEntry :: FilePath -> Set DiagnosticCode -> Diagnostic -> CheckReportEntry sourceEntry subject deniedCodes diagnostic =   CheckReportEntry-    { entryCode = code diagnostic,-      entrySeverity = severity diagnostic,-      entryFile = subject,-      entryLine = line diagnostic,-      entryMessage = message diagnostic,-      entryDenied = warningDenied deniedCodes (severity diagnostic) (code diagnostic),-      entryRelated =+    { code = (.code) diagnostic,+      severity = (.severity) diagnostic,+      file = subject,+      line = (.line) diagnostic,+      message = (.message) diagnostic,+      denied = warningDenied deniedCodes ((.severity) diagnostic) ((.code) diagnostic),+      related =         [ CheckReportRelated subject relatedLineNumber note-        | (relatedLineNumber, note) <- relatedLocations diagnostic+        | (relatedLineNumber, note) <- (.relatedLocations) diagnostic         ]     }  workspaceEntry :: FilePath -> Set DiagnosticCode -> WorkspaceDiagnostic -> CheckReportEntry workspaceEntry subject deniedCodes diagnostic =   CheckReportEntry-    { entryCode = wdCode diagnostic,-      entrySeverity = wdSeverity diagnostic,-      entryFile = workspaceDisplayPath subject (wlFile primary),-      entryLine = wlLine primary,-      entryMessage = wdMessage diagnostic,-      entryDenied = warningDenied deniedCodes (wdSeverity diagnostic) (wdCode diagnostic),-      entryRelated =+    { code = (.code) diagnostic,+      severity = (.severity) diagnostic,+      file = workspaceDisplayPath subject ((.file) primary),+      line = (.line) primary,+      message = (.message) diagnostic,+      denied = warningDenied deniedCodes ((.severity) diagnostic) ((.code) diagnostic),+      related =         [ CheckReportRelated-            (workspaceDisplayPath subject (wlFile location))-            (wlLine location)-            (wlRole location)-        | location <- NE.tail (wdLocations diagnostic)+            (workspaceDisplayPath subject ((.file) location))+            ((.line) location)+            ((.role) location)+        | location <- NE.tail ((.locations) diagnostic)         ]     }   where-    primary = NE.head (wdLocations diagnostic)+    primary = NE.head ((.locations) diagnostic)  warningDenied :: Set DiagnosticCode -> Severity -> DiagnosticCode -> Bool warningDenied deniedCodes severityValue diagnosticCode =@@ -266,15 +266,15 @@   toJSON report =     object       ( [ "schema" .= ("keiro-dsl/check-report/1" :: Text),-          "kind" .= kindText (reportKind report),-          "subject" .= reportSubject report,-          "language" .= fmap languageJson (reportLanguage report),-          "enforcement" .= enforcementJson (reportEnforcement report),-          "diagnostics" .= map entryJson (reportDiagnostics report),-          "summary" .= summaryJson (reportSummary report),-          "ok" .= reportOk report+          "kind" .= kindText ((.kind) report),+          "subject" .= (.subject) report,+          "language" .= fmap languageJson ((.language) report),+          "enforcement" .= enforcementJson ((.enforcement) report),+          "diagnostics" .= map entryJson ((.diagnostics) report),+          "summary" .= summaryJson ((.summary) report),+          "ok" .= (.ok) report         ]-          <> ["members" .= map memberJson (reportMembers report) | reportKind report == WorkspaceReport]+          <> ["members" .= map memberJson ((.members) report) | (.kind) report == WorkspaceReport]       )  kindText :: CheckReportKind -> Text@@ -284,56 +284,56 @@ languageJson :: CheckReportLanguage -> Value languageJson language =   object-    [ "sourceForm" .= reportSourceForm language,-      "declaredLanguageVersion" .= reportDeclaredLanguageVersion language,-      "effectiveLanguageVersion" .= reportEffectiveLanguageVersion language,-      "runtimeSemantics" .= reportRuntimeSemantics language,-      "languageSupport" .= languageSupportText (reportLanguageSupport language),-      "stable" .= reportStable language+    [ "sourceForm" .= (.sourceForm) language,+      "declaredLanguageVersion" .= (.declaredLanguageVersion) language,+      "effectiveLanguageVersion" .= (.effectiveLanguageVersion) language,+      "runtimeSemantics" .= (.runtimeSemantics) language,+      "languageSupport" .= languageSupportText ((.languageSupport) language),+      "stable" .= (.stable) language     ]  enforcementJson :: CheckReportEnforcement -> Value enforcementJson enforcement =   object-    [ "minLanguage" .= reportMinLanguage enforcement,-      "denyWarnings" .= reportDenyWarnings enforcement,-      "denyCodes" .= map diagnosticCodeText (Set.toAscList (Set.fromList (reportDenyCodes enforcement)))+    [ "minLanguage" .= (.minLanguage) enforcement,+      "denyWarnings" .= (.denyWarnings) enforcement,+      "denyCodes" .= map diagnosticCodeText (Set.toAscList (Set.fromList ((.denyCodes) enforcement)))     ]  entryJson :: CheckReportEntry -> Value entryJson entry =   object-    [ "code" .= diagnosticCodeText (entryCode entry),-      "severity" .= severityText (entrySeverity entry),-      "file" .= entryFile entry,-      "line" .= entryLine entry,-      "message" .= entryMessage entry,-      "denied" .= entryDenied entry,-      "related" .= map relatedJson (entryRelated entry)+    [ "code" .= diagnosticCodeText ((.code) entry),+      "severity" .= severityText ((.severity) entry),+      "file" .= (.file) entry,+      "line" .= (.line) entry,+      "message" .= (.message) entry,+      "denied" .= (.denied) entry,+      "related" .= map relatedJson ((.related) entry)     ]  relatedJson :: CheckReportRelated -> Value relatedJson related =   object-    [ "file" .= relatedFile related,-      "line" .= relatedLine related,-      "note" .= relatedNote related+    [ "file" .= (.file) related,+      "line" .= (.line) related,+      "note" .= (.note) related     ]  summaryJson :: CheckReportSummary -> Value summaryJson summary =   object-    [ "errors" .= summaryErrors summary,-      "warnings" .= summaryWarnings summary,-      "deniedWarnings" .= summaryDeniedWarnings summary+    [ "errors" .= (.errors) summary,+      "warnings" .= (.warnings) summary,+      "deniedWarnings" .= (.deniedWarnings) summary     ]  memberJson :: CheckReportMember -> Value memberJson member =   object-    [ "path" .= memberPath member,-      "sourceForm" .= memberSourceForm member,-      "declaredLanguageVersion" .= memberDeclaredLanguageVersion member+    [ "path" .= (.path) member,+      "sourceForm" .= (.sourceForm) member,+      "declaredLanguageVersion" .= (.declaredLanguageVersion) member     ]  severityText :: Severity -> Text

src/Keiro/Dsl/CodecCompare.hs view

@@ -9,6 +9,7 @@   ( FixtureOrigin (..),     DecodeOutcome (..),     JsonPointer (..),+    unJsonPointer,     ComparisonDifference (..),     HistoricalCodec (..),     CompareObservation (..),@@ -69,6 +70,9 @@ newtype JsonPointer = JsonPointer {unJsonPointer :: Text}   deriving stock (Eq, Ord, Show) +unJsonPointer :: JsonPointer -> Text+unJsonPointer (JsonPointer value) = value+ data ComparisonDifference   = EncodedValueDifference !JsonPointer !Value !Value   | DecodedValueDifference !JsonPointer !Value !Value@@ -78,23 +82,23 @@ -- | A historical codec is an explicit value supplied by consumer-owned test -- code. Its identity and version are report provenance, not dispatch keys. data HistoricalCodec a = HistoricalCodec-  { hcIdentity :: !Text,-    hcVersion :: !Text,-    hcEncode :: !(a -> Value),-    hcDecode :: !(Value -> Either Text a)+  { identity :: !Text,+    version :: !Text,+    encode :: !(a -> Value),+    decode :: !(Value -> Either Text a)   }  data CompareObservation   = EncodeObservation-      { coCaseName :: !Text,-        coHistoricalValue :: !Value,-        coGeneratedValue :: !Value+      { caseName :: !Text,+        historicalValue :: !Value,+        generatedValue :: !Value       }   | DecodeObservation-      { coFixturePath :: !FilePath,-        coInputValue :: !Value,-        coHistoricalDecode :: !DecodeOutcome,-        coGeneratedDecode :: !DecodeOutcome+      { fixturePath :: !FilePath,+        inputValue :: !Value,+        historicalDecode :: !DecodeOutcome,+        generatedDecode :: !DecodeOutcome       }   deriving stock (Eq, Show) @@ -117,23 +121,23 @@   deriving stock (Eq, Ord, Show)  data DeclaredBranch = DeclaredBranch-  { dbOrigin :: !FixtureOrigin,-    dbPointer :: !JsonPointer,-    dbKind :: !BranchKind+  { origin :: !FixtureOrigin,+    pointer :: !JsonPointer,+    kind :: !BranchKind   }   deriving stock (Eq, Ord, Show)  data ObservedBranch = ObservedBranch-  { obOrigin :: !FixtureOrigin,-    obPointer :: !JsonPointer,-    obKind :: !BranchKind+  { origin :: !FixtureOrigin,+    pointer :: !JsonPointer,+    kind :: !BranchKind   }   deriving stock (Eq, Ord, Show)  data CoverageGap = CoverageGap-  { cgOrigin :: !FixtureOrigin,-    cgPointer :: !JsonPointer,-    cgKind :: !BranchKind+  { origin :: !FixtureOrigin,+    pointer :: !JsonPointer,+    kind :: !BranchKind   }   deriving stock (Eq, Ord, Show) @@ -150,47 +154,47 @@   deriving stock (Eq, Show)  data BranchField = BranchField-  { bfWireKey :: !Text,-    bfPresenceOptional :: !Bool,-    bfSchema :: !BranchSchema+  { wireKey :: !Text,+    presenceOptional :: !Bool,+    schema :: !BranchSchema   }   deriving stock (Eq, Show)  data BranchArm = BranchArm-  { baWireTag :: !Text,-    baPayloadSchema :: !(Maybe BranchSchema)+  { wireTag :: !Text,+    payloadSchema :: !(Maybe BranchSchema)   }   deriving stock (Eq, Show)  data CompareProvenance = CompareProvenance-  { cpHistoricalCodecIdentity :: !Text,-    cpHistoricalCodecVersion :: !Text,-    cpCanonicalType :: !CanonicalTypeId,-    cpBindingSymbol :: !QualifiedValueName,-    cpBindingVersion :: !BindingVersion,-    cpWireFingerprint :: !Text+  { historicalCodecIdentity :: !Text,+    historicalCodecVersion :: !Text,+    canonicalType :: !CanonicalTypeId,+    bindingSymbol :: !QualifiedValueName,+    bindingVersion :: !BindingVersion,+    wireFingerprint :: !Text   }   deriving stock (Eq, Show)  data ClassifiedObservation = ClassifiedObservation-  { classifiedOrigin :: !FixtureOrigin,-    classifiedName :: !Text,-    classifiedVerdict :: !FixtureVerdict+  { origin :: !FixtureOrigin,+    name :: !Text,+    verdict :: !FixtureVerdict   }   deriving stock (Eq, Show)  data CompareReport = CompareReport-  { crProvenance :: !CompareProvenance,-    crObservations :: ![ClassifiedObservation],-    crInputIssues :: ![CompareInputIssue],-    crCoverageGaps :: ![CoverageGap],-    crAuthority :: !Text+  { provenance :: !CompareProvenance,+    observations :: ![ClassifiedObservation],+    inputIssues :: ![CompareInputIssue],+    coverageGaps :: ![CoverageGap],+    authority :: !Text   }   deriving stock (Eq, Show)  data ReportWriteError = ReportWriteError-  { reportWritePath :: !FilePath,-    reportWriteMessage :: !Text+  { path :: !FilePath,+    message :: !Text   }   deriving stock (Eq, Show) @@ -227,11 +231,11 @@   CompareReport compareReport provenance suppliedIssues observations declaredBranches observedBranches =   CompareReport-    { crProvenance = provenance,-      crObservations = classified,-      crInputIssues = provenanceIssues provenance <> suppliedIssues <> classificationIssues,-      crCoverageGaps = coverageGaps declaredBranches observedBranches,-      crAuthority = authorityStatement+    { provenance = provenance,+      observations = classified,+      inputIssues = provenanceIssues provenance <> suppliedIssues <> classificationIssues,+      coverageGaps = coverageGaps declaredBranches observedBranches,+      authority = authorityStatement     }   where     outcomes = map classify observations@@ -243,9 +247,9 @@       Right verdict ->         Right           ClassifiedObservation-            { classifiedOrigin = observationOrigin observation,-              classifiedName = observationName observation,-              classifiedVerdict = verdict+            { origin = observationOrigin observation,+              name = observationName observation,+              verdict = verdict             }  observationOrigin :: CompareObservation -> FixtureOrigin@@ -253,28 +257,28 @@ observationOrigin DecodeObservation {} = HistoricalGolden  observationName :: CompareObservation -> Text-observationName EncodeObservation {coCaseName = name} = name-observationName DecodeObservation {coFixturePath = path} = T.pack path+observationName EncodeObservation {caseName = name} = name+observationName DecodeObservation {fixturePath = path} = T.pack path  provenanceIssues :: CompareProvenance -> [CompareInputIssue] provenanceIssues provenance =   [ HistoricalCodecProvenanceInvalid "historical codec identity must not be blank"-  | T.null (T.strip (cpHistoricalCodecIdentity provenance))+  | T.null (T.strip ((.historicalCodecIdentity) provenance))   ]     <> [ HistoricalCodecProvenanceInvalid "historical codec version must not be blank"-       | T.null (T.strip (cpHistoricalCodecVersion provenance))+       | T.null (T.strip ((.historicalCodecVersion) provenance))        ]  coverageGaps :: [DeclaredBranch] -> [ObservedBranch] -> [CoverageGap] coverageGaps declared observed =-  [ CoverageGap (dbOrigin branch) (dbPointer branch) (dbKind branch)+  [ CoverageGap ((.origin) branch) ((.pointer) branch) ((.kind) branch)   | branch <- declared,     branchKey branch `Set.notMember` observedKeys   ]   where     observedKeys = Set.fromList (map observedBranchKey observed)-    branchKey branch = (dbOrigin branch, dbPointer branch, dbKind branch)-    observedBranchKey branch = (obOrigin branch, obPointer branch, obKind branch)+    branchKey branch = ((.origin) branch, (.pointer) branch, (.kind) branch)+    observedBranchKey branch = ((.origin) branch, (.pointer) branch, (.kind) branch)  declaredBranchesFor :: FixtureOrigin -> BranchSchema -> [DeclaredBranch] declaredBranchesFor origin = Set.toAscList . go ""@@ -290,18 +294,18 @@       BranchMap nested -> go (appendPointer pointer "*") nested       BranchRecord fields ->         Set.unions-          [ presenceBranches pointer field <> go (appendPointer pointer (bfWireKey field)) (bfSchema field)+          [ presenceBranches pointer field <> go (appendPointer pointer ((.wireKey) field)) ((.schema) field)           | field <- fields           ]       BranchUnion _tagField contentsField arms ->         Set.unions-          [ declared pointer (UnionArm (baWireTag arm))-              <> maybe Set.empty (go (appendPointer pointer contentsField)) (baPayloadSchema arm)+          [ declared pointer (UnionArm ((.wireTag) arm))+              <> maybe Set.empty (go (appendPointer pointer contentsField)) ((.payloadSchema) arm)           | arm <- arms           ]     presenceBranches pointer field-      | bfPresenceOptional field =-          let fieldPointer = appendPointer pointer (bfWireKey field)+      | (.presenceOptional) field =+          let fieldPointer = appendPointer pointer ((.wireKey) field)            in case origin of                 HistoricalGolden -> declared fieldPointer OptionalMissing <> declared fieldPointer OptionalPresent                 FromBinding -> declared fieldPointer OptionalPresent@@ -327,43 +331,43 @@         _ -> Set.empty       BranchUnion tagField contentsField arms -> case value of         Object values -> case KeyMap.lookup (Key.fromText tagField) values of-          Just (String tag) -> case filter ((== tag) . baWireTag) arms of+          Just (String tag) -> case filter ((== tag) . (.wireTag)) arms of             arm : _ ->               observed pointer (UnionArm tag)-                <> case (baPayloadSchema arm, KeyMap.lookup (Key.fromText contentsField) values) of+                <> case ((.payloadSchema) arm, KeyMap.lookup (Key.fromText contentsField) values) of                   (Just nested, Just payload) -> go (appendPointer pointer contentsField) nested payload                   _ -> Set.empty             [] -> Set.empty           _ -> Set.empty         _ -> Set.empty     observeField pointer values field =-      let fieldPointer = appendPointer pointer (bfWireKey field)-       in case KeyMap.lookup (Key.fromText (bfWireKey field)) values of+      let fieldPointer = appendPointer pointer ((.wireKey) field)+       in case KeyMap.lookup (Key.fromText ((.wireKey) field)) values of             Nothing-              | bfPresenceOptional field -> observed fieldPointer OptionalMissing+              | (.presenceOptional) field -> observed fieldPointer OptionalMissing               | otherwise -> Set.empty             Just fieldValue ->-              (if bfPresenceOptional field then observed fieldPointer OptionalPresent else Set.empty)-                <> go fieldPointer (bfSchema field) fieldValue+              (if (.presenceOptional) field then observed fieldPointer OptionalPresent else Set.empty)+                <> go fieldPointer ((.schema) field) fieldValue  reportSucceeded :: CompareReport -> Bool reportSucceeded report =-  null (crInputIssues report)-    && null (crCoverageGaps report)-    && all ((== JsonParity) . classifiedVerdict) (crObservations report)+  null ((.inputIssues) report)+    && null ((.coverageGaps) report)+    && all ((== JsonParity) . (.verdict)) ((.observations) report)  renderCompareReport :: CompareReport -> Text renderCompareReport report =   T.unlines     ( [ "codec comparison: "-          <> unCanonicalTypeId (cpCanonicalType provenance)+          <> (.unCanonicalTypeId) ((.canonicalType) provenance)           <> " (binding-version \""-          <> unBindingVersion (cpBindingVersion provenance)+          <> (.unBindingVersion) ((.bindingVersion) provenance)           <> "\")",         "historical codec: \""-          <> cpHistoricalCodecIdentity provenance+          <> (.historicalCodecIdentity) provenance           <> "\" version \""-          <> cpHistoricalCodecVersion provenance+          <> (.historicalCodecVersion) provenance           <> "\"",         "observations: " <> tshow (length observations),         "  encode parity: " <> ratio FromBinding,@@ -371,38 +375,38 @@         "requires explicit version/upcaster work: " <> tshow (length differences) <> " observations  [" <> codeText CodecCompareDifference <> "]"       ]         <> concatMap renderDifference differences-        <> [ "input issues: " <> tshow (length (crInputIssues report)) <> "  [" <> codeText CodecCompareInvalidInput <> "]"+        <> [ "input issues: " <> tshow (length ((.inputIssues) report)) <> "  [" <> codeText CodecCompareInvalidInput <> "]"            ]-        <> map ("  " <>) (map renderInputIssue (crInputIssues report))-        <> [ "coverage gaps: " <> tshow (length (crCoverageGaps report)) <> "  [" <> codeText CodecCompareCoverageGap <> "]"+        <> map ("  " <>) (map renderInputIssue ((.inputIssues) report))+        <> [ "coverage gaps: " <> tshow (length ((.coverageGaps) report)) <> "  [" <> codeText CodecCompareCoverageGap <> "]"            ]-        <> map ("  " <>) (map renderCoverageGap (crCoverageGaps report))+        <> map ("  " <>) (map renderCoverageGap ((.coverageGaps) report))         <> [ if reportSucceeded report                then "result: PARITY"                else "result: NOT PARITY — " <> tshow (length differences) <> " differences",-             crAuthority report+             (.authority) report            ]     )   where-    provenance = crProvenance report-    observations = crObservations report-    differences = filter ((/= JsonParity) . classifiedVerdict) observations+    provenance = (.provenance) report+    observations = (.observations) report+    differences = filter ((/= JsonParity) . (.verdict)) observations     ratio origin =-      let matching = filter ((== origin) . classifiedOrigin) observations-          parityCount = length (filter ((== JsonParity) . classifiedVerdict) matching)+      let matching = filter ((== origin) . (.origin)) observations+          parityCount = length (filter ((== JsonParity) . (.verdict)) matching)        in tshow parityCount <> "/" <> tshow (length matching) <> suffix origin     suffix FromBinding = " (RFC 8785 canonical form)"     suffix HistoricalGolden = ""  renderDifference :: ClassifiedObservation -> [Text]-renderDifference observation = case classifiedVerdict observation of+renderDifference observation = case (.verdict) observation of   JsonParity -> []   RequiresVersionWork difference ->-    [ "  " <> classifiedName observation <> " [" <> direction <> "] at " <> pointerOf difference,+    [ "  " <> (.name) observation <> " [" <> direction <> "] at " <> pointerOf difference,       "    " <> reasonOf difference     ]   where-    direction = case classifiedOrigin observation of+    direction = case (.origin) observation of       FromBinding -> "encode"       HistoricalGolden -> "decode" @@ -414,11 +418,11 @@  renderCoverageGap :: CoverageGap -> Text renderCoverageGap gap =-  originName (cgOrigin gap)+  originName ((.origin) gap)     <> " "-    <> renderPointer (cgPointer gap)+    <> renderPointer ((.pointer) gap)     <> ": "-    <> branchKindName (cgKind gap)+    <> branchKindName ((.kind) gap)  pointerOf :: ComparisonDifference -> Text pointerOf difference = case difference of@@ -643,9 +647,9 @@ instance ToJSON DeclaredBranch where   toJSON branch =     object-      [ "origin" .= dbOrigin branch,-        "pointer" .= dbPointer branch,-        "branch" .= dbKind branch+      [ "origin" .= (.origin) branch,+        "pointer" .= (.pointer) branch,+        "branch" .= (.kind) branch       ]  instance FromJSON DeclaredBranch where@@ -655,9 +659,9 @@ instance ToJSON ObservedBranch where   toJSON branch =     object-      [ "origin" .= obOrigin branch,-        "pointer" .= obPointer branch,-        "branch" .= obKind branch+      [ "origin" .= (.origin) branch,+        "pointer" .= (.pointer) branch,+        "branch" .= (.kind) branch       ]  instance FromJSON ObservedBranch where@@ -668,9 +672,9 @@   toJSON gap =     object       [ "code" .= codeText CodecCompareCoverageGap,-        "origin" .= cgOrigin gap,-        "pointer" .= cgPointer gap,-        "branch" .= cgKind gap+        "origin" .= (.origin) gap,+        "pointer" .= (.pointer) gap,+        "branch" .= (.kind) gap       ]  instance FromJSON CoverageGap where@@ -680,12 +684,12 @@ instance ToJSON CompareProvenance where   toJSON provenance =     object-      [ "historicalCodecIdentity" .= cpHistoricalCodecIdentity provenance,-        "historicalCodecVersion" .= cpHistoricalCodecVersion provenance,-        "canonicalType" .= unCanonicalTypeId (cpCanonicalType provenance),-        "bindingSymbol" .= unQualifiedValueName (cpBindingSymbol provenance),-        "bindingVersion" .= unBindingVersion (cpBindingVersion provenance),-        "wireFingerprint" .= cpWireFingerprint provenance+      [ "historicalCodecIdentity" .= (.historicalCodecIdentity) provenance,+        "historicalCodecVersion" .= (.historicalCodecVersion) provenance,+        "canonicalType" .= (.unCanonicalTypeId) ((.canonicalType) provenance),+        "bindingSymbol" .= (.unQualifiedValueName) ((.bindingSymbol) provenance),+        "bindingVersion" .= (.unBindingVersion) ((.bindingVersion) provenance),+        "wireFingerprint" .= (.wireFingerprint) provenance       ]  instance FromJSON CompareProvenance where@@ -701,9 +705,9 @@ instance ToJSON ClassifiedObservation where   toJSON observation =     object-      [ "origin" .= classifiedOrigin observation,-        "name" .= classifiedName observation,-        "result" .= classifiedVerdict observation+      [ "origin" .= (.origin) observation,+        "name" .= (.name) observation,+        "result" .= (.verdict) observation       ]  instance FromJSON ClassifiedObservation where@@ -714,20 +718,20 @@   toJSON report =     object       [ "schema" .= ("keiro-dsl/codec-compare-report/1" :: Text),-        "authority" .= crAuthority report,-        "provenance" .= crProvenance report,+        "authority" .= (.authority) report,+        "provenance" .= (.provenance) report,         "success" .= reportSucceeded report,         "summary"           .= object-            [ "observations" .= length (crObservations report),-              "parity" .= length (filter ((== JsonParity) . classifiedVerdict) (crObservations report)),-              "differences" .= length (filter ((/= JsonParity) . classifiedVerdict) (crObservations report)),-              "inputIssues" .= length (crInputIssues report),-              "coverageGaps" .= length (crCoverageGaps report)+            [ "observations" .= length ((.observations) report),+              "parity" .= length (filter ((== JsonParity) . (.verdict)) ((.observations) report)),+              "differences" .= length (filter ((/= JsonParity) . (.verdict)) ((.observations) report)),+              "inputIssues" .= length ((.inputIssues) report),+              "coverageGaps" .= length ((.coverageGaps) report)             ],-        "observations" .= crObservations report,-        "inputIssues" .= crInputIssues report,-        "coverageGaps" .= crCoverageGaps report+        "observations" .= (.observations) report,+        "inputIssues" .= (.inputIssues) report,+        "coverageGaps" .= (.coverageGaps) report       ]  instance FromJSON CompareReport where

src/Keiro/Dsl/ConformancePackage.hs view

@@ -55,19 +55,19 @@   deriving stock (Eq, Ord, Show)  data ConformanceFile = ConformanceFile-  { conformanceFilePath :: !FilePath,-    conformanceFileText :: !Text,-    conformanceFileKind :: !ModuleKind+  { path :: !FilePath,+    text :: !Text,+    kind :: !ModuleKind   }   deriving stock (Eq, Show)  data ConformancePackagePlan = ConformancePackagePlan-  { cppServiceKey :: !ConformanceServiceKey,-    cppDirectory :: !FilePath,-    cppPackageName :: !Text,-    cppRuntimePackage :: !RuntimePackageName,-    cppFacadeModule :: !Text,-    cppFiles :: ![ConformanceFile]+  { serviceKey :: !ConformanceServiceKey,+    directory :: !FilePath,+    packageName :: !Text,+    runtimePackage :: !RuntimePackageName,+    facadeModule :: !Text,+    files :: ![ConformanceFile]   }   deriving stock (Eq, Show) @@ -75,8 +75,8 @@   deriving stock (Eq, Ord, Show)  data DuplicateFactKey = DuplicateFactKey-  { duplicateFactSide :: !ConformanceFactSide,-    duplicateFactKey :: !String+  { side :: !ConformanceFactSide,+    key :: !String   }   deriving stock (Eq, Ord, Show) @@ -98,11 +98,11 @@   deriving stock (Eq, Show)  data ConformancePackageRecord = ConformancePackageRecord-  { cprSchema :: !Int,-    cprServiceKey :: !ConformanceServiceKey,-    cprRuntimePackage :: !RuntimePackageName,-    cprFacadeModule :: !Text,-    cprFiles :: ![(ModuleKind, FilePath)]+  { schema :: !Int,+    serviceKey :: !ConformanceServiceKey,+    runtimePackage :: !RuntimePackageName,+    facadeModule :: !Text,+    files :: ![(ModuleKind, FilePath)]   }   deriving stock (Eq, Show) @@ -110,24 +110,24 @@   deriving stock (Eq, Show)  data ConformanceStaleFile = ConformanceStaleFile-  { conformanceStaleKind :: !ModuleKind,-    conformanceStalePath :: !FilePath,-    conformanceStaleBannerPresent :: !(Maybe Bool)+  { kind :: !ModuleKind,+    path :: !FilePath,+    bannerPresent :: !(Maybe Bool)   }   deriving stock (Eq, Show)  data PreparedConformancePackage = PreparedConformancePackage-  { preparedRoot :: !FilePath,-    preparedPlan :: !ConformancePackagePlan,-    preparedStale :: ![ConformanceStaleFile]+  { root :: !FilePath,+    plan :: !ConformancePackagePlan,+    stale :: ![ConformanceStaleFile]   }   deriving stock (Eq, Show)  data ConformancePackageReport = ConformancePackageReport-  { conformanceReportRoot :: !FilePath,-    conformanceReportPlan :: !ConformancePackagePlan,-    conformanceReportDispositions :: ![(ConformanceFile, ConformanceWriteDisposition)],-    conformanceReportStale :: ![ConformanceStaleFile]+  { root :: !FilePath,+    plan :: !ConformancePackagePlan,+    dispositions :: ![(ConformanceFile, ConformanceWriteDisposition)],+    stale :: ![ConformanceStaleFile]   }   deriving stock (Eq, Show) @@ -171,32 +171,32 @@         ConformanceFile "src/Main.hs" (renderMain banner facadeModule) Generated,         ConformanceFile "src/KeiroConformance/Expectations.hs" (renderExpectations factValues) HoleStub       ]-    recordRows = [(conformanceFileKind file, conformanceFilePath file) | file <- baseFiles] <> [(Generated, conformanceRecordFileName)]+    recordRows = [((.kind) file, (.path) file) | file <- baseFiles] <> [(Generated, conformanceRecordFileName)]     record =       ConformancePackageRecord-        { cprSchema = 1,-          cprServiceKey = serviceKey,-          cprRuntimePackage = runtimePackage,-          cprFacadeModule = facadeModule,-          cprFiles = recordRows+        { schema = 1,+          serviceKey = serviceKey,+          runtimePackage = runtimePackage,+          facadeModule = facadeModule,+          files = recordRows         }     recordFile = ConformanceFile conformanceRecordFileName (banner <> "\n" <> renderConformancePackageRecord record) Generated     files = baseFiles <> [recordFile]-    paths = packageDirectory : map conformanceFilePath files+    paths = packageDirectory : map (.path) files     unsafePaths = filter (not . safeRelativePath) paths     collisions =       [ entries-      | entries <- Map.elems (Map.fromListWith (<>) [(T.toCaseFold (T.pack path), [path]) | path <- map conformanceFilePath files]),+      | entries <- Map.elems (Map.fromListWith (<>) [(T.toCaseFold (T.pack path), [path]) | path <- map (.path) files]),         length entries > 1       ]     plan =       ConformancePackagePlan-        { cppServiceKey = serviceKey,-          cppDirectory = packageDirectory,-          cppPackageName = packageName,-          cppRuntimePackage = runtimePackage,-          cppFacadeModule = facadeModule,-          cppFiles = files+        { serviceKey = serviceKey,+          directory = packageDirectory,+          packageName = packageName,+          runtimePackage = runtimePackage,+          facadeModule = facadeModule,+          files = files         }  renderCabal :: Text -> Text -> RuntimePackageName -> Text -> Text@@ -218,7 +218,7 @@       "  ghc-options: -Wall",       "  build-depends:",       "      base >=4.18 && <5",-      "    , " <> unRuntimePackageName runtimePackage,+      "    , " <> (.unRuntimePackageName) runtimePackage,       "  default-language: GHC2024",       "  default-extensions: OverloadedStrings"     ]@@ -320,11 +320,11 @@ renderConformancePackageRecord record =   T.unlines $     [ conformanceLedgerHeader,-      "service-key " <> renderServiceKey (cprServiceKey record),-      "runtime-package " <> unRuntimePackageName (cprRuntimePackage record),-      "facade-module " <> cprFacadeModule record+      "service-key " <> renderServiceKey ((.serviceKey) record),+      "runtime-package " <> (.unRuntimePackageName) ((.runtimePackage) record),+      "facade-module " <> (.facadeModule) record     ]-      <> ["file " <> encodeConformanceFileRow (ConformanceFileRow fileKind path) | (fileKind, path) <- cprFiles record]+      <> ["file " <> encodeConformanceFileRow (ConformanceFileRow fileKind path) | (fileKind, path) <- (.files) record]  parseConformancePackageRecord :: Text -> Maybe ConformancePackageRecord parseConformancePackageRecord input = case meaningfulLines input of@@ -337,16 +337,16 @@       runtimePackage <- exactlyOne [value | row <- rows, Just raw <- [T.stripPrefix "runtime-package " row], Right value <- [mkRuntimePackageName raw]]       facadeModule <- exactlyOne [value | row <- rows, Just value <- [T.stripPrefix "facade-module " row], not (T.null value), T.all (not . (`elem` [' ', '\t'])) value]       fileRows <- traverse decodeConformanceFileRow [row | row <- rows, "file " `T.isPrefixOf` row]-      let files = [(conformanceRowKind row, conformanceRowPath row) | row <- fileRows]+      let files = [((.kind) row, (.path) row) | row <- fileRows]       if safeServiceKey serviceKey && safeConformanceFiles files         then           Just             ConformancePackageRecord-              { cprSchema = 1,-                cprServiceKey = serviceKey,-                cprRuntimePackage = runtimePackage,-                cprFacadeModule = facadeModule,-                cprFiles = files+              { schema = 1,+                serviceKey = serviceKey,+                runtimePackage = runtimePackage,+                facadeModule = facadeModule,+                files = files               }         else Nothing @@ -365,11 +365,11 @@     then       Just         ConformancePackageRecord-          { cprSchema = schema,-            cprServiceKey = serviceKey,-            cprRuntimePackage = runtimePackage,-            cprFacadeModule = facadeModule,-            cprFiles = files+          { schema = schema,+            serviceKey = serviceKey,+            runtimePackage = runtimePackage,+            facadeModule = facadeModule,+            files = files           }     else Nothing   where@@ -385,15 +385,15 @@ conformanceLedgerHeader = "keiro-dsl conformance ledger v1"  data ConformanceFileRow = ConformanceFileRow-  { conformanceRowKind :: !ModuleKind,-    conformanceRowPath :: !FilePath+  { kind :: !ModuleKind,+    path :: !FilePath   }  instance ToJSON ConformanceFileRow where   toJSON row =     object-      [ "kind" .= case conformanceRowKind row of Generated -> "generated" :: Text; HoleStub -> "create-once",-        "path" .= T.pack (conformanceRowPath row)+      [ "kind" .= case (.kind) row of Generated -> "generated" :: Text; HoleStub -> "create-once",+        "path" .= T.pack ((.path) row)       ]  instance FromJSON ConformanceFileRow where@@ -438,16 +438,16 @@  preflightConformancePackage :: FilePath -> Bool -> ConformancePackagePlan -> IO (Either [ConformancePackageFailure] PreparedConformancePackage) preflightConformancePackage out forceGeneratedOverwrite plan = do-  bannerless <- if forceGeneratedOverwrite then pure [] else missingPackageBanners root (cppFiles plan)+  bannerless <- if forceGeneratedOverwrite then pure [] else missingPackageBanners root ((.files) plan)   previousResult <- readPreviousRecord root forceGeneratedOverwrite bannerless plan-  case [ConformanceGeneratedBannerMissing (map (cppDirectory plan </>) bannerless) | not (null bannerless)] <> either id (const []) previousResult of+  case [ConformanceGeneratedBannerMissing (map ((.directory) plan </>) bannerless) | not (null bannerless)] <> either id (const []) previousResult of     failures@(_ : _) -> pure (Left failures)     [] -> do       let previous = either (const Nothing) id previousResult-      stale <- maybe (pure []) (stalePackageFiles root (map conformanceFilePath (cppFiles plan))) previous-      pure (Right PreparedConformancePackage {preparedRoot = root, preparedPlan = plan, preparedStale = stale})+      stale <- maybe (pure []) (stalePackageFiles root (map (.path) ((.files) plan))) previous+      pure (Right PreparedConformancePackage {root = root, plan = plan, stale = stale})   where-    root = out </> cppDirectory plan+    root = out </> (.directory) plan  readPreviousRecord :: FilePath -> Bool -> [FilePath] -> ConformancePackagePlan -> IO (Either [ConformancePackageFailure] (Maybe ConformancePackageRecord)) readPreviousRecord root forceGeneratedOverwrite bannerless plan = do@@ -458,22 +458,22 @@     else do       parsed <- parseConformancePackageRecord <$> TIO.readFile path       pure $ case parsed of-        Nothing -> Left [InvalidConformancePackageRecord (cppDirectory plan </> conformanceRecordFileName)]+        Nothing -> Left [InvalidConformancePackageRecord ((.directory) plan </> conformanceRecordFileName)]         Just record-          | cprServiceKey record == cppServiceKey plan -> Right (Just record)-          | otherwise -> Left [ConformancePackageRecordMismatch (cppDirectory plan </> conformanceRecordFileName)]+          | (.serviceKey) record == (.serviceKey) plan -> Right (Just record)+          | otherwise -> Left [ConformancePackageRecordMismatch ((.directory) plan </> conformanceRecordFileName)]  missingPackageBanners :: FilePath -> [ConformanceFile] -> IO [FilePath] missingPackageBanners root files = fmap concat . forM generated $ \file -> do-  let path = root </> conformanceFilePath file+  let path = root </> (.path) file   exists <- doesFileExist path   if not exists     then pure []     else do       contents <- TIO.readFile path-      pure [conformanceFilePath file | not (any isGeneratedBannerLine (T.lines contents))]+      pure [(.path) file | not (any isGeneratedBannerLine (T.lines contents))]   where-    generated = [file | file <- files, conformanceFileKind file == Generated]+    generated = [file | file <- files, (.kind) file == Generated]  stalePackageFiles :: FilePath -> [FilePath] -> ConformancePackageRecord -> IO [ConformanceStaleFile] stalePackageFiles root current record = fmap concat . forM removed $ \(fileKind, path) -> do@@ -489,40 +489,40 @@       pure [ConformanceStaleFile fileKind path evidence]   where     currentSet = Set.fromList current-    removed = [(fileKind, path) | (fileKind, path) <- cprFiles record, path `Set.notMember` currentSet]+    removed = [(fileKind, path) | (fileKind, path) <- (.files) record, path `Set.notMember` currentSet]  executePreparedConformancePackage :: PreparedConformancePackage -> IO ConformancePackageReport executePreparedConformancePackage prepared = do-  dispositions <- traverse (writeConformanceFile (preparedRoot prepared)) (cppFiles plan)+  dispositions <- traverse (writeConformanceFile ((.root) prepared)) ((.files) plan)   pure     ConformancePackageReport-      { conformanceReportRoot = preparedRoot prepared,-        conformanceReportPlan = plan,-        conformanceReportDispositions = dispositions,-        conformanceReportStale = preparedStale prepared+      { root = (.root) prepared,+        plan = plan,+        dispositions = dispositions,+        stale = (.stale) prepared       }   where-    plan = preparedPlan prepared+    plan = (.plan) prepared  writeConformanceFile :: FilePath -> ConformanceFile -> IO (ConformanceFile, ConformanceWriteDisposition) writeConformanceFile root file = do-  let path = root </> conformanceFilePath file+  let path = root </> (.path) file   exists <- doesFileExist path-  case conformanceFileKind file of+  case (.kind) file of     HoleStub       | exists -> pure (file, ConformanceSkipped)       | otherwise -> write path ConformanceCreated     Generated       | exists -> do           existing <- TIO.readFile path-          if existing == conformanceFileText file+          if existing == (.text) file             then pure (file, ConformanceUnchanged)             else write path ConformanceOverwritten       | otherwise -> write path ConformanceCreated   where     write path disposition = do       createDirectoryIfMissing True (takeDirectory path)-      TIO.writeFile path (conformanceFileText file)+      TIO.writeFile path ((.text) file)       pure (file, disposition)  compareConformanceFacts :: [(String, String)] -> [(String, String)] -> Either [DuplicateFactKey] [ConformanceFactResult]@@ -556,7 +556,7 @@   ConformancePathCollision paths -> ["error: conformance package path collision -- refusing to scaffold; nothing was written"] <> map ("  " <>) (map T.pack paths)   PackageDuplicateFactKeys duplicates ->     ["error: duplicate conformance fact keys -- refusing to scaffold; nothing was written"]-      <> ["  " <> sideLabel (duplicateFactSide duplicate) <> "/" <> T.pack (duplicateFactKey duplicate) | duplicate <- duplicates]+      <> ["  " <> sideLabel ((.side) duplicate) <> "/" <> T.pack ((.key) duplicate) | duplicate <- duplicates]   ConformanceGeneratedBannerMissing paths ->     ["error: refusing to overwrite generated conformance package files without a recognized '-- @generated' banner"]       <> map ("  " <>) (map T.pack paths)@@ -570,33 +570,33 @@ renderConformancePackageReport :: ConformancePackageReport -> [Text] renderConformancePackageReport report =   [ "conformance-package: " <> T.pack cabalPath,-    "conformance-target: cabal test " <> cppPackageName plan+    "conformance-target: cabal test " <> (.packageName) plan   ]-    <> [ "conformance-file: " <> T.pack (root </> conformanceFilePath file) <> " " <> dispositionTag disposition+    <> [ "conformance-file: " <> T.pack (root </> (.path) file) <> " " <> dispositionTag disposition        | (file, disposition) <- dispositions,-         conformanceFileKind file == Generated,-         conformanceFilePath file /= conformanceRecordFileName+         (.kind) file == Generated,+         (.path) file /= conformanceRecordFileName        ]-    <> ["expectations: " <> T.pack (root </> conformanceFilePath file) <> " " <> dispositionTag disposition | (file, disposition) <- dispositions, conformanceFileKind file == HoleStub]-    <> ["conformance-record: " <> T.pack (root </> conformanceRecordFileName) <> " " <> dispositionTag disposition | (file, disposition) <- dispositions, conformanceFilePath file == conformanceRecordFileName]+    <> ["expectations: " <> T.pack (root </> (.path) file) <> " " <> dispositionTag disposition | (file, disposition) <- dispositions, (.kind) file == HoleStub]+    <> ["conformance-record: " <> T.pack (root </> conformanceRecordFileName) <> " " <> dispositionTag disposition | (file, disposition) <- dispositions, (.path) file == conformanceRecordFileName]     <> staleLines   where-    plan = conformanceReportPlan report-    root = conformanceReportRoot report-    dispositions = conformanceReportDispositions report-    cabalPath = root </> T.unpack (cppPackageName plan) <> ".cabal"+    plan = (.plan) report+    root = (.root) report+    dispositions = (.dispositions) report+    cabalPath = root </> T.unpack ((.packageName) plan) <> ".cabal"     dispositionTag ConformanceCreated = "(created)"     dispositionTag ConformanceOverwritten = "(overwritten)"     dispositionTag ConformanceSkipped = "(skipped: already present)"     dispositionTag ConformanceUnchanged = "(unchanged)"-    staleLines = case conformanceReportStale report of+    staleLines = case (.stale) report of       [] -> []       stale ->         ["conformance-stale: " <> tshow (length stale) <> " file(s) are no longer produced; keiro-dsl never deletes files."]-          <> ["  " <> staleKindLabel (conformanceStaleKind file) <> " " <> T.pack (root </> conformanceStalePath file) <> staleEvidence file | file <- stale]+          <> ["  " <> staleKindLabel ((.kind) file) <> " " <> T.pack (root </> (.path) file) <> staleEvidence file | file <- stale]     staleKindLabel Generated = "generated"     staleKindLabel HoleStub = "create-once"-    staleEvidence file = case conformanceStaleBannerPresent file of+    staleEvidence file = case (.bannerPresent) file of       Nothing -> " (hand-owned; preserve and review)"       Just True -> " (recognized generated banner present; review before deleting)"       Just False -> " (generated banner missing; preserve and review)"

src/Keiro/Dsl/ConsumerTypePlan.hs view

@@ -5,6 +5,7 @@ -- queue and read-model emitters add their own surface authority around it. module Keiro.Dsl.ConsumerTypePlan   ( HaskellTypeOccurrence (..),+    unHaskellTypeOccurrence,     ImportRequirement (..),     ConsumerTypePlan (..),     ConsumerTypePlanError (..),@@ -27,6 +28,9 @@   }   deriving stock (Eq, Ord, Show) +unHaskellTypeOccurrence :: HaskellTypeOccurrence -> Text+unHaskellTypeOccurrence (HaskellTypeOccurrence value) = value+ -- | One deterministic import needed to render the planned type. Consumer -- package provenance is retained so later Cabal planning does not need to -- rediscover it from the raw specification.@@ -70,16 +74,16 @@       ROptional value -> application "Maybe" [ImportRequirement "base" "Data.Maybe" "Maybe"] <$> plan value       RList value -> listType <$> plan value       RMap value -> mapType <$> plan value-      RRef key -> case Map.lookup key (tgDeclarations graph) of+      RRef key -> case Map.lookup key ((.declarations) graph) of         Nothing -> Left (ConsumerTypePlanUnknownDeclaration key)         Just declaration ->           let source = mappedSource declaration            in Right                 RenderedType-                  { rendered = hsType source,+                  { rendered = (.valueType) source,                     precedence = AtomicType,-                    requirements = Set.singleton (ImportRequirement (hsPackage source) (hsModule source) (hsType source)),-                    mappedDependencies = Set.insert key (Map.findWithDefault Set.empty key (tgReachability graph))+                    requirements = Set.singleton (ImportRequirement ((.package) source) ((.moduleName) source) ((.valueType) source)),+                    mappedDependencies = Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph))                   }      atom rendered requiredImports =@@ -92,33 +96,29 @@           }      application constructor requiredImports value =-      value-        { rendered = constructor <> " " <> argument value,-          precedence = ApplicationType,-          requirements = Set.fromList requiredImports <> requirements value-        }+      replaceRenderedType+        (constructor <> " " <> argument value)+        ApplicationType+        (Set.fromList requiredImports <> value.requirements)+        value -    listType value =-      value-        { rendered = "[" <> rendered value <> "]",-          precedence = AtomicType-        }+    listType value = replaceRenderedType ("[" <> value.rendered <> "]") AtomicType value.requirements value      mapType value =-      value-        { rendered = "Map Text " <> argument value,-          precedence = ApplicationType,-          requirements =-            Set.fromList-              [ ImportRequirement "containers" "Data.Map.Strict" "Map",-                ImportRequirement "text" "Data.Text" "Text"-              ]-              <> requirements value-        }+      replaceRenderedType+        ("Map Text " <> argument value)+        ApplicationType+        ( Set.fromList+            [ ImportRequirement "containers" "Data.Map.Strict" "Map",+              ImportRequirement "text" "Data.Text" "Text"+            ]+            <> value.requirements+        )+        value -    argument value = case precedence value of-      AtomicType -> rendered value-      ApplicationType -> "(" <> rendered value <> ")"+    argument value = case (.precedence) value of+      AtomicType -> (.rendered) value+      ApplicationType -> "(" <> (.rendered) value <> ")"  data TypePrecedence = AtomicType | ApplicationType @@ -130,14 +130,14 @@   }  mappedSource :: ResolvedMappedDecl -> HaskellSource-mappedSource (ResolvedStructural declaration _) = sdHaskell declaration-mappedSource (ResolvedOpaque declaration) = odHaskell declaration+mappedSource (ResolvedStructural declaration _) = (.haskell) declaration+mappedSource (ResolvedOpaque declaration) = (.haskell) declaration  consumerTypeReferences :: ConsumerTypePlan -> Set HaskellReference consumerTypeReferences planned =   Set.fromList     [ HaskellReference moduleName occurrence TypeNamespace PreferUnqualified-    | ImportRequirement {package, moduleName, occurrence} <- imports planned,+    | ImportRequirement {package, moduleName, occurrence} <- (.imports) planned,       package `Set.notMember` standardPackages     ]   where@@ -147,7 +147,7 @@ -- import plan. This is the collision-safe counterpart to 'haskellType', whose -- unqualified text remains useful for diagnostics and dependency reports. renderConsumerType :: HaskellImportPlan -> TypeGraph -> ResolvedTypeExpr -> Either ConsumerTypePlanError HaskellTypeOccurrence-renderConsumerType importPlan graph = fmap (HaskellTypeOccurrence . rendered) . render+renderConsumerType importPlan graph = fmap (HaskellTypeOccurrence . (.rendered)) . render   where     render = \case       RText -> pure (plainAtom "Text")@@ -161,23 +161,29 @@       RList value -> listType <$> render value       RMap value -> do         renderedValue <- render value-        pure-          renderedValue-            { rendered = "Map Text " <> argument renderedValue,-              precedence = ApplicationType-            }-      RRef key -> case Map.lookup key (tgDeclarations graph) of+        pure $+          replaceRenderedType ("Map Text " <> argument renderedValue) ApplicationType renderedValue.requirements renderedValue+      RRef key -> case Map.lookup key ((.declarations) graph) of         Nothing -> Left (ConsumerTypePlanUnknownDeclaration key)         Just declaration ->           let source = mappedSource declaration-           in atom (hsType source) (reference (hsModule source) (hsType source))+           in atom ((.valueType) source) (reference ((.moduleName) source) ((.valueType) source))      atom _ ref = plainAtom <$> plannedReference ref     plainAtom value = RenderedType value AtomicType Set.empty Set.empty-    application constructor value = value {rendered = constructor <> " " <> argument value, precedence = ApplicationType}-    listType value = value {rendered = "[" <> rendered value <> "]", precedence = AtomicType}-    argument value = case precedence value of-      AtomicType -> rendered value-      ApplicationType -> "(" <> rendered value <> ")"+    application constructor value = replaceRenderedType (constructor <> " " <> argument value) ApplicationType value.requirements value+    listType value = replaceRenderedType ("[" <> value.rendered <> "]") AtomicType value.requirements value+    argument value = case (.precedence) value of+      AtomicType -> (.rendered) value+      ApplicationType -> "(" <> (.rendered) value <> ")"     reference moduleName occurrence = HaskellReference moduleName occurrence TypeNamespace PreferUnqualified     plannedReference = either (Left . ConsumerTypePlanImportError) Right . renderPlannedReference importPlan++replaceRenderedType :: Text -> TypePrecedence -> Set ImportRequirement -> RenderedType -> RenderedType+replaceRenderedType rendered precedence requirements value =+  RenderedType+    { rendered,+      precedence,+      requirements,+      mappedDependencies = value.mappedDependencies+    }

src/Keiro/Dsl/CoordinationImpact.hs view

@@ -57,18 +57,18 @@ -- | Durable selection ownership metadata. Locations and query files are absent; -- the ledger owns only the verification boundary and checked semantic identity. data RouterSelectionSnapshot = RouterSelectionSnapshot-  { selectionRouter :: !Name,-    selectionVerification :: !SelectionVerification,-    selectionIdentity :: !(Maybe Text),-    selectionVersion :: !(Maybe Natural),-    selectionFingerprint :: !(Maybe Text)+  { router :: !Name,+    verification :: !SelectionVerification,+    identity :: !(Maybe Text),+    version :: !(Maybe Natural),+    fingerprint :: !(Maybe Text)   }   deriving stock (Eq, Ord, Show, Generic)  data CoordinationImpact = CoordinationImpact-  { coordinationRouter :: !Name,-    coordinationSeverity :: !CoordinationSeverity,-    coordinationReason :: !CoordinationReason,+  { router :: !Name,+    severity :: !CoordinationSeverity,+    reason :: !CoordinationReason,     previousVerification :: !SelectionVerification,     currentVerification :: !SelectionVerification,     previousIdentity :: !(Maybe Text),@@ -82,9 +82,9 @@   deriving stock (Eq, Show, Generic)  data RouterSelectionDrift = RouterSelectionDrift-  { driftRouter :: !Name,-    driftPreviousSelection :: !(Maybe RouterSelectionSnapshot),-    driftCurrentSelection :: !(Maybe RouterSelectionSnapshot)+  { router :: !Name,+    previousSelection :: !(Maybe RouterSelectionSnapshot),+    currentSelection :: !(Maybe RouterSelectionSnapshot)   }   deriving stock (Eq, Show, Generic) @@ -102,11 +102,11 @@ instance ToJSON RouterSelectionSnapshot where   toJSON snapshot =     object-      [ "router" .= selectionRouter snapshot,-        "verification" .= selectionVerification snapshot,-        "identity" .= selectionIdentity snapshot,-        "version" .= selectionVersion snapshot,-        "fingerprint" .= selectionFingerprint snapshot+      [ "router" .= (.router) snapshot,+        "verification" .= (.verification) snapshot,+        "identity" .= (.identity) snapshot,+        "version" .= (.version) snapshot,+        "fingerprint" .= (.fingerprint) snapshot       ]  instance FromJSON RouterSelectionSnapshot where@@ -124,23 +124,23 @@ instance ToJSON CoordinationImpact where   toJSON impact =     object-      [ "router" .= coordinationRouter impact,-        "severity" .= severityIdentity (coordinationSeverity impact),-        "reason" .= reasonIdentity (coordinationReason impact),-        "previousVerification" .= previousVerification impact,-        "currentVerification" .= currentVerification impact,-        "previousIdentity" .= previousIdentity impact,-        "currentIdentity" .= currentIdentity impact,-        "previousVersion" .= previousVersion impact,-        "currentVersion" .= currentVersion impact,-        "previousFingerprint" .= previousFingerprint impact,-        "currentFingerprint" .= currentFingerprint impact,-        "affectedUseSites" .= map (renderUsePath . (`UsePath` [])) (affectedUseSites impact)+      [ "router" .= (.router) impact,+        "severity" .= severityIdentity ((.severity) impact),+        "reason" .= reasonIdentity ((.reason) impact),+        "previousVerification" .= (.previousVerification) impact,+        "currentVerification" .= (.currentVerification) impact,+        "previousIdentity" .= (.previousIdentity) impact,+        "currentIdentity" .= (.currentIdentity) impact,+        "previousVersion" .= (.previousVersion) impact,+        "currentVersion" .= (.currentVersion) impact,+        "previousFingerprint" .= (.previousFingerprint) impact,+        "currentFingerprint" .= (.currentFingerprint) impact,+        "affectedUseSites" .= map (renderUsePath . (`UsePath` [])) ((.affectedUseSites) impact)       ]  -- | Freeze every router's checked coordination metadata in canonical name order. routerSelectionSnapshots :: CheckedService -> [RouterSelectionSnapshot]-routerSelectionSnapshots = sortOn selectionRouter . map stateSnapshot . routerSelectionStates+routerSelectionSnapshots = sortOn (.router) . map (.snapshot) . routerSelectionStates  routerSelectionDrift :: [RouterSelectionSnapshot] -> [RouterSelectionSnapshot] -> [RouterSelectionDrift] routerSelectionDrift previous current =@@ -151,23 +151,23 @@     old /= new   ]   where-    oldByRouter = Map.fromList [(selectionRouter snapshot, snapshot) | snapshot <- previous]-    newByRouter = Map.fromList [(selectionRouter snapshot, snapshot) | snapshot <- current]+    oldByRouter = Map.fromList [((.router) snapshot, snapshot) | snapshot <- previous]+    newByRouter = Map.fromList [((.router) snapshot, snapshot) | snapshot <- current]  renderRouterSelectionDrift :: [RouterSelectionDrift] -> [Text] renderRouterSelectionDrift [] = [] renderRouterSelectionDrift drifts = "router selection coordination metadata:" : concatMap renderDrift drifts   where     renderDrift drift =-      [ "  " <> driftRouter drift,-        "    previous: " <> maybe "(none)" renderSnapshot (driftPreviousSelection drift),-        "    current:  " <> maybe "(none)" renderSnapshot (driftCurrentSelection drift)+      [ "  " <> (.router) drift,+        "    previous: " <> maybe "(none)" renderSnapshot ((.previousSelection) drift),+        "    current:  " <> maybe "(none)" renderSnapshot ((.currentSelection) drift)       ]     renderSnapshot snapshot =-      verificationIdentity (selectionVerification snapshot)-        <> maybe "" (" identity=" <>) (selectionIdentity snapshot)-        <> maybe "" ((" version=" <>) . T.pack . show) (selectionVersion snapshot)-        <> maybe "" (" fingerprint=" <>) (selectionFingerprint snapshot)+      verificationIdentity ((.verification) snapshot)+        <> maybe "" (" identity=" <>) ((.identity) snapshot)+        <> maybe "" ((" version=" <>) . T.pack . show) ((.version) snapshot)+        <> maybe "" (" fingerprint=" <>) ((.fingerprint) snapshot)  coordinationImpact :: CheckedService -> CheckedService -> [MappedImpactDelta] -> [CoordinationImpact] coordinationImpact previous current mappedDeltas =@@ -184,7 +184,7 @@       Set.toAscList . Set.fromList $         [ router         | delta <- mappedDeltas,-          consumer <- Set.toList (impactPreviousConsumers delta <> impactCurrentConsumers delta),+          consumer <- Set.toList ((.previousConsumers) delta <> (.currentConsumers) delta),           RouterSelectionConsumer router _ <- [consumer]         ]     mappedImpacts =@@ -193,20 +193,20 @@           SelectionMappedDependencyChanged           oldState           newState-          (stateUseSites oldState <> stateUseSites newState)+          ((.useSites) oldState <> (.useSites) newState)       | router <- affectedRouters,         Just oldState <- [Map.lookup router previousStates],         Just newState <- [Map.lookup router currentStates]       ]-    impactOrder impact = (coordinationRouter impact, coordinationReason impact)+    impactOrder impact = ((.router) impact, (.reason) impact)  data RouterSelectionState = RouterSelectionState-  { stateSnapshot :: !RouterSelectionSnapshot,-    stateUseSites :: ![UseSite]+  { snapshot :: !RouterSelectionSnapshot,+    useSites :: ![UseSite]   }  stateMap :: CheckedService -> Map Name RouterSelectionState-stateMap = Map.fromList . map (\state -> (selectionRouter (stateSnapshot state), state)) . routerSelectionStates+stateMap = Map.fromList . map (\state -> ((.router) ((.snapshot) state), state)) . routerSelectionStates  routerSelectionStates :: CheckedService -> [RouterSelectionState] routerSelectionStates service = case checkedTypeGraph service of@@ -214,35 +214,35 @@   Right graph -> map (routerState graph) routers   where     spec = checkedSpec service-    routers = [router | NRouter router <- specNodes spec]-    routerState graph router = case rvSource (rtResolve router) of+    routers = [router | NRouter router <- (.nodes) spec]+    routerState graph router = case (.source) ((.resolve) router) of       ResolveDeclarative {} -> case checkRouterSelection (checkedLanguageContract service) graph spec router of         Left failures -> error ("validated declarative router selection did not check for coordination: " <> show failures)         Right selection ->           RouterSelectionState-            { stateSnapshot =+            { snapshot =                 RouterSelectionSnapshot-                  { selectionRouter = rtId router,-                    selectionVerification = DeclarativeVerified,-                    selectionIdentity = Just (checkedIdentity selection),-                    selectionVersion = Just (checkedVersion selection),-                    selectionFingerprint = Just (checkedFingerprint selection)+                  { router = (.id) router,+                    verification = DeclarativeVerified,+                    identity = Just ((.identity) selection),+                    version = Just ((.version) selection),+                    fingerprint = Just ((.fingerprint) selection)                   },-              stateUseSites = checkedUseSites selection+              useSites = (.useSites) selection             }       ResolveReadModel {} -> customState router       ResolveHole -> customState router     customState router =       RouterSelectionState-        { stateSnapshot =+        { snapshot =             RouterSelectionSnapshot-              { selectionRouter = rtId router,-                selectionVerification = CustomUnverified,-                selectionIdentity = Nothing,-                selectionVersion = Nothing,-                selectionFingerprint = Nothing+              { router = (.id) router,+                verification = CustomUnverified,+                identity = Nothing,+                version = Nothing,+                fingerprint = Nothing               },-          stateUseSites = []+          useSites = []         }  directImpact :: RouterSelectionState -> RouterSelectionState -> Maybe CoordinationImpact@@ -256,51 +256,51 @@   | oldFingerprint == newFingerprint && newVersion > oldVersion = advisory SelectionVersionMetadataOnly   | otherwise = Nothing   where-    old = stateSnapshot oldState-    new = stateSnapshot newState-    oldVerification = selectionVerification old-    newVerification = selectionVerification new-    oldIdentity = selectionIdentity old-    newIdentity = selectionIdentity new-    oldVersion = selectionVersion old-    newVersion = selectionVersion new-    oldFingerprint = selectionFingerprint old-    newFingerprint = selectionFingerprint new-    useSites = stateUseSites oldState <> stateUseSites newState+    old = (.snapshot) oldState+    new = (.snapshot) newState+    oldVerification = (.verification) old+    newVerification = (.verification) new+    oldIdentity = (.identity) old+    newIdentity = (.identity) new+    oldVersion = (.version) old+    newVersion = (.version) new+    oldFingerprint = (.fingerprint) old+    newFingerprint = (.fingerprint) new+    useSites = (.useSites) oldState <> (.useSites) newState     advisory reason = Just (mkImpact CoordinationAdvisory reason oldState newState useSites)     breaking reason = Just (mkImpact CoordinationBreaking reason oldState newState useSites)  mkImpact :: CoordinationSeverity -> CoordinationReason -> RouterSelectionState -> RouterSelectionState -> [UseSite] -> CoordinationImpact mkImpact severity reason oldState newState useSites =   CoordinationImpact-    { coordinationRouter = selectionRouter new,-      coordinationSeverity = severity,-      coordinationReason = reason,-      previousVerification = selectionVerification old,-      currentVerification = selectionVerification new,-      previousIdentity = selectionIdentity old,-      currentIdentity = selectionIdentity new,-      previousVersion = selectionVersion old,-      currentVersion = selectionVersion new,-      previousFingerprint = selectionFingerprint old,-      currentFingerprint = selectionFingerprint new,+    { router = (.router) new,+      severity = severity,+      reason = reason,+      previousVerification = (.verification) old,+      currentVerification = (.verification) new,+      previousIdentity = (.identity) old,+      currentIdentity = (.identity) new,+      previousVersion = (.version) old,+      currentVersion = (.version) new,+      previousFingerprint = (.fingerprint) old,+      currentFingerprint = (.fingerprint) new,       affectedUseSites = Set.toAscList (Set.fromList useSites)     }   where-    old = stateSnapshot oldState-    new = stateSnapshot newState+    old = (.snapshot) oldState+    new = (.snapshot) newState  renderCoordinationImpact :: [CoordinationImpact] -> [Text] renderCoordinationImpact [] = [] renderCoordinationImpact impacts = "coordination impact:" : concatMap renderImpact impacts   where     renderImpact impact =-      [ "  " <> coordinationRouter impact <> ": " <> severityIdentity (coordinationSeverity impact) <> " (" <> reasonIdentity (coordinationReason impact) <> ")",-        "    verification: " <> verificationIdentity (previousVerification impact) <> " -> " <> verificationIdentity (currentVerification impact),-        "    identity: " <> renderMaybe (previousIdentity impact) <> " -> " <> renderMaybe (currentIdentity impact),-        "    version: " <> renderMaybeShow (previousVersion impact) <> " -> " <> renderMaybeShow (currentVersion impact),-        "    fingerprint: " <> renderMaybe (previousFingerprint impact) <> " -> " <> renderMaybe (currentFingerprint impact),-        "    affected use sites: " <> renderUseSites (affectedUseSites impact)+      [ "  " <> (.router) impact <> ": " <> severityIdentity ((.severity) impact) <> " (" <> reasonIdentity ((.reason) impact) <> ")",+        "    verification: " <> verificationIdentity ((.previousVerification) impact) <> " -> " <> verificationIdentity ((.currentVerification) impact),+        "    identity: " <> renderMaybe ((.previousIdentity) impact) <> " -> " <> renderMaybe ((.currentIdentity) impact),+        "    version: " <> renderMaybeShow ((.previousVersion) impact) <> " -> " <> renderMaybeShow ((.currentVersion) impact),+        "    fingerprint: " <> renderMaybe ((.previousFingerprint) impact) <> " -> " <> renderMaybe ((.currentFingerprint) impact),+        "    affected use sites: " <> renderUseSites ((.affectedUseSites) impact)       ]     renderMaybe = maybe "(unverified)" id     renderMaybeShow = maybe "(unverified)" (T.pack . show)@@ -308,11 +308,11 @@     renderUseSites values = T.intercalate ", " (map (renderUsePath . (`UsePath` [])) values)  snapshotValid :: RouterSelectionSnapshot -> Bool-snapshotValid snapshot = case selectionVerification snapshot of+snapshotValid snapshot = case (.verification) snapshot of   DeclarativeVerified -> allPresent   CustomUnverified -> allAbsent   where-    fields = [() <$ selectionIdentity snapshot, () <$ selectionVersion snapshot, () <$ selectionFingerprint snapshot]+    fields = [() <$ (.identity) snapshot, () <$ (.version) snapshot, () <$ (.fingerprint) snapshot]     allPresent = all (/= Nothing) fields     allAbsent = all (== Nothing) fields

src/Keiro/Dsl/Coverage.hs view

@@ -63,60 +63,60 @@   deriving stock (Eq, Ord, Show)  data CoverageRoot = CoverageRoot-  { rootSurface :: !CoverageSurface,-    rootConsumer :: !Text,-    rootPath :: !Text,-    rootMappedType :: !Text,-    rootMode :: !CoverageMode,-    rootCanonicalType :: !(Maybe Text),-    rootCodecIdentity :: !(Maybe Text),-    rootCodecVersion :: !(Maybe Text),-    rootWireFingerprint :: !Text+  { surface :: !CoverageSurface,+    consumer :: !Text,+    path :: !Text,+    mappedType :: !Text,+    mode :: !CoverageMode,+    canonicalType :: !(Maybe Text),+    codecIdentity :: !(Maybe Text),+    codecVersion :: !(Maybe Text),+    wireFingerprint :: !Text   }   deriving stock (Eq, Ord, Show)  data StructuralBoundary = StructuralBoundary-  { structuralRoot :: !Text,-    structuralPath :: !Text,-    structuralMappedType :: !Text,-    structuralCanonicalType :: !Text,-    structuralWireFingerprint :: !Text+  { root :: !Text,+    path :: !Text,+    mappedType :: !Text,+    canonicalType :: !Text,+    wireFingerprint :: !Text   }   deriving stock (Eq, Ord, Show)  data OpaqueBoundary = OpaqueBoundary-  { opaqueRoot :: !Text,-    opaquePath :: !Text,-    opaqueMappedType :: !Text,-    opaqueCodecIdentity :: !Text,-    opaqueCodecVersion :: !Text+  { root :: !Text,+    path :: !Text,+    mappedType :: !Text,+    codecIdentity :: !Text,+    codecVersion :: !Text   }   deriving stock (Eq, Ord, Show)  data JsonBoundary = JsonBoundary-  { jsonSurface :: !CoverageSurface,-    jsonRoot :: !Text,-    jsonPath :: !Text+  { surface :: !CoverageSurface,+    root :: !Text,+    path :: !Text   }   deriving stock (Eq, Ord, Show)  data SnapshotBoundary = SnapshotBoundary-  { snapshotRoot :: !Text,-    snapshotAggregate :: !Text,-    snapshotRegister :: !Text,-    snapshotMappedType :: !Text,-    snapshotMode :: !CoverageMode,-    snapshotEncoding :: !Text,-    snapshotInvalidation :: !Text,-    snapshotWireFingerprint :: !Text,-    snapshotEnabled :: !Bool+  { root :: !Text,+    aggregate :: !Text,+    register :: !Text,+    mappedType :: !Text,+    mode :: !CoverageMode,+    encoding :: !Text,+    invalidation :: !Text,+    wireFingerprint :: !Text,+    enabled :: !Bool   }   deriving stock (Eq, Ord, Show)  data UnsupportedSurface = UnsupportedSurface-  { unsupportedSurface :: !Text,-    unsupportedSupport :: !Text,-    unsupportedReason :: !Text+  { surface :: !Text,+    support :: !Text,+    reason :: !Text   }   deriving stock (Eq, Ord, Show) @@ -140,17 +140,17 @@   deriving stock (Eq, Show)  data CoverageFinding = CoverageFinding-  { findingSeverity :: !Severity,-    findingCode :: !DiagnosticCode,-    findingRoots :: ![Text],-    findingMessage :: !Text+  { severity :: !Severity,+    code :: !DiagnosticCode,+    roots :: ![Text],+    message :: !Text   }   deriving stock (Eq, Show)  data CoveragePrevious = CoveragePrevious-  { previousReference :: !Text,-    previousSummary :: !CoverageSummary,-    previousOpaqueBoundaries :: ![OpaqueBoundary]+  { reference :: !Text,+    summary :: !CoverageSummary,+    opaqueBoundaries :: ![OpaqueBoundary]   }   deriving stock (Eq, Show) @@ -169,17 +169,17 @@   deriving stock (Eq, Show)  data CoverageReport = CoverageReport-  { coverageSpec :: !FilePath,-    coverageRoots :: ![CoverageRoot],-    coverageStructuralBoundaries :: ![StructuralBoundary],-    coverageOpaqueBoundaries :: ![OpaqueBoundary],-    coverageJsonBoundaries :: ![JsonBoundary],-    coverageSnapshotBoundaries :: ![SnapshotBoundary],-    coverageUnsupportedSurfaces :: ![UnsupportedSurface],-    coverageSummary :: !CoverageSummary,-    coverageFindings :: ![CoverageFinding],-    coveragePrevious :: !(Maybe CoveragePrevious),-    coverageDelta :: !(Maybe CoverageDelta)+  { spec :: !FilePath,+    roots :: ![CoverageRoot],+    structuralBoundaries :: ![StructuralBoundary],+    opaqueBoundaries :: ![OpaqueBoundary],+    jsonBoundaries :: ![JsonBoundary],+    snapshotBoundaries :: ![SnapshotBoundary],+    unsupportedSurfaces :: ![UnsupportedSurface],+    summary :: !CoverageSummary,+    findings :: ![CoverageFinding],+    previous :: !(Maybe CoveragePrevious),+    delta :: !(Maybe CoverageDelta)   }   deriving stock (Eq, Show) @@ -191,126 +191,144 @@   graph <- checkedTypeGraph service   let spec = checkedSpec service   let impact = semanticImpact graph-      roots = sortOn (\root -> (rootPath root, rootConsumer root, rootSurface root)) (map (coverageRoot graph) (impactRoots impact))+      roots = sortOn (\root -> ((.path) root, (.consumer) root, (.surface) root)) (map (coverageRoot graph) ((.roots) impact))       structural = structuralBoundaryInventory graph       opaque = opaqueBoundaryInventory graph-      json = sortOn jsonPath (jsonBoundaryInventory graph <> queueExplicitJsonBoundaries spec)+      json = sortOn (.path) (jsonBoundaryInventory graph <> queueExplicitJsonBoundaries spec)       snapshots = snapshotBoundaryInventory spec graph       summary = summarize roots json       findings = opaqueSurfaceFindings opaque   pure     CoverageReport-      { coverageSpec = specPath,-        coverageRoots = roots,-        coverageStructuralBoundaries = structural,-        coverageOpaqueBoundaries = opaque,-        coverageJsonBoundaries = json,-        coverageSnapshotBoundaries = snapshots,-        coverageUnsupportedSurfaces = unsupportedInventory graph,-        coverageSummary = summary,-        coverageFindings = findings,-        coveragePrevious = Nothing,-        coverageDelta = Nothing+      { spec = specPath,+        roots = roots,+        structuralBoundaries = structural,+        opaqueBoundaries = opaque,+        jsonBoundaries = json,+        snapshotBoundaries = snapshots,+        unsupportedSurfaces = unsupportedInventory graph,+        summary = summary,+        findings = findings,+        previous = Nothing,+        delta = Nothing       }  coverageDiffReport :: FilePath -> Text -> Spec -> Spec -> Either (NonEmpty TypeGraphError) CoverageReport coverageDiffReport specPath reference oldSpec newSpec = do   oldReport <- coverageReport (T.unpack reference <> ":" <> specPath) oldSpec   newReport <- coverageReport specPath newSpec-  let oldOpaque = Set.fromList (coverageOpaqueBoundaries oldReport)-      newOpaque = Set.fromList (coverageOpaqueBoundaries newReport)+  let oldOpaque = Set.fromList ((.opaqueBoundaries) oldReport)+      newOpaque = Set.fromList ((.opaqueBoundaries) newReport)       added = Set.toAscList (newOpaque `Set.difference` oldOpaque)       removed = Set.toAscList (oldOpaque `Set.difference` newOpaque)-      oldSummary = coverageSummary oldReport-      newSummary = coverageSummary newReport+      oldSummary = (.summary) oldReport+      newSummary = (.summary) newReport       delta =         CoverageDelta-          { aggregateCommandRootDelta = totalRoots (aggregateCommandPayloads newSummary) - totalRoots (aggregateCommandPayloads oldSummary),-            privateEventRootDelta = totalRoots (privateEventPayloads newSummary) - totalRoots (privateEventPayloads oldSummary),-            snapshotRegisterRootDelta = totalRoots (snapshotRegisters newSummary) - totalRoots (snapshotRegisters oldSummary),-            workqueuePayloadRootDelta = totalRoots (workqueuePayloads newSummary) - totalRoots (workqueuePayloads oldSummary),-            readModelQueryInputRootDelta = totalRoots (readModelQueryInputs newSummary) - totalRoots (readModelQueryInputs oldSummary),-            readModelQueryResultRootDelta = totalRoots (readModelQueryResults newSummary) - totalRoots (readModelQueryResults oldSummary),-            projectionTypedConsumerRootDelta = totalRoots (projectionTypedConsumers newSummary) - totalRoots (projectionTypedConsumers oldSummary),+          { aggregateCommandRootDelta = (.totalRoots) ((.aggregateCommandPayloads) newSummary) - (.totalRoots) ((.aggregateCommandPayloads) oldSummary),+            privateEventRootDelta = (.totalRoots) ((.privateEventPayloads) newSummary) - (.totalRoots) ((.privateEventPayloads) oldSummary),+            snapshotRegisterRootDelta = (.totalRoots) ((.snapshotRegisters) newSummary) - (.totalRoots) ((.snapshotRegisters) oldSummary),+            workqueuePayloadRootDelta = (.totalRoots) ((.workqueuePayloads) newSummary) - (.totalRoots) ((.workqueuePayloads) oldSummary),+            readModelQueryInputRootDelta = (.totalRoots) ((.readModelQueryInputs) newSummary) - (.totalRoots) ((.readModelQueryInputs) oldSummary),+            readModelQueryResultRootDelta = (.totalRoots) ((.readModelQueryResults) newSummary) - (.totalRoots) ((.readModelQueryResults) oldSummary),+            projectionTypedConsumerRootDelta = (.totalRoots) ((.projectionTypedConsumers) newSummary) - (.totalRoots) ((.projectionTypedConsumers) oldSummary),             opaqueBoundaryDelta = length added - length removed,             addedOpaqueBoundaries = added,             removedOpaqueBoundaries = removed           }       addedFindings =         [ CoverageFinding-            { findingSeverity = Warning,-              findingCode = CoverageOpaqueBoundaryAdded,-              findingRoots = [opaqueRoot boundary],-              findingMessage = "opaque boundary added at " <> opaquePath boundary+            { severity = Warning,+              code = CoverageOpaqueBoundaryAdded,+              roots = [(.root) boundary],+              message = "opaque boundary added at " <> (.path) boundary             }         | boundary <- added         ]-  pure-    newReport-      { coverageFindings = coverageFindings newReport <> addedFindings,-        coveragePrevious =-          Just-            CoveragePrevious-              { previousReference = reference,-                previousSummary = oldSummary,-                previousOpaqueBoundaries = coverageOpaqueBoundaries oldReport-              },-        coverageDelta = Just delta-      }+  pure $+    replaceCoverageReportComparison+      (newReport.findings <> addedFindings)+      ( Just+          CoveragePrevious+            { reference = reference,+              summary = oldSummary,+              opaqueBoundaries = oldReport.opaqueBoundaries+            }+      )+      (Just delta)+      newReport  failOnOpaque :: CoverageReport -> CoverageReport failOnOpaque report   | null boundaries = report-  | otherwise = report {coverageFindings = coverageFindings report <> [gateFinding "opaque persisted boundaries are forbidden by --fail-on-opaque" boundaries]}+  | otherwise = replaceCoverageReportFindings (report.findings <> [gateFinding "opaque persisted boundaries are forbidden by --fail-on-opaque" boundaries]) report   where-    boundaries = coverageOpaqueBoundaries report+    boundaries = (.opaqueBoundaries) report  failOnOpaqueIncrease :: CoverageReport -> CoverageReport-failOnOpaqueIncrease report = case coverageDelta report of+failOnOpaqueIncrease report = case (.delta) report of   Just delta-    | not (null (addedOpaqueBoundaries delta)) ->-        report-          { coverageFindings =-              coverageFindings report-                <> [gateFinding "new opaque persisted boundaries are forbidden by --fail-on-opaque-increase" (addedOpaqueBoundaries delta)]-          }+    | not (null ((.addedOpaqueBoundaries) delta)) ->+        replaceCoverageReportFindings+          (report.findings <> [gateFinding "new opaque persisted boundaries are forbidden by --fail-on-opaque-increase" delta.addedOpaqueBoundaries])+          report   _ -> report +replaceCoverageReportFindings :: [CoverageFinding] -> CoverageReport -> CoverageReport+replaceCoverageReportFindings findings report =+  replaceCoverageReportComparison findings report.previous report.delta report++replaceCoverageReportComparison :: [CoverageFinding] -> Maybe CoveragePrevious -> Maybe CoverageDelta -> CoverageReport -> CoverageReport+replaceCoverageReportComparison findings previous delta report =+  CoverageReport+    { spec = report.spec,+      roots = report.roots,+      structuralBoundaries = report.structuralBoundaries,+      opaqueBoundaries = report.opaqueBoundaries,+      jsonBoundaries = report.jsonBoundaries,+      snapshotBoundaries = report.snapshotBoundaries,+      unsupportedSurfaces = report.unsupportedSurfaces,+      summary = report.summary,+      findings,+      previous,+      delta+    }+ coverageSucceeded :: CoverageReport -> Bool-coverageSucceeded = all ((/= Error) . findingSeverity) . coverageFindings+coverageSucceeded = all ((/= Error) . (.severity)) . (.findings)  renderCoverageSummary :: CoverageReport -> Text renderCoverageSummary report =   T.unlines     [ "structural/opaque boundaries (reporting only):",-      "  aggregate-command-payloads: " <> renderCounts (aggregateCommandPayloads summary) <> "; encoding=consumer-build-only",-      "  private-event-payloads: " <> renderCounts (privateEventPayloads summary),-      "  snapshot-registers: " <> renderCounts (snapshotRegisters summary) <> "; encoding=consumer-json-cache; invalidation=tracked",-      "  queue-payloads: " <> renderCounts (workqueuePayloads summary) <> "; encoding=queue-envelope-v1; migration=drain-or-transitional-codec",-      "  read-model-query-inputs: " <> renderCounts (readModelQueryInputs summary) <> "; encoding=generated-haskell-api",-      "  read-model-query-results: " <> renderCounts (readModelQueryResults summary) <> "; encoding=generated-haskell-api",-      "  projection-typed-consumers: " <> renderCounts (projectionTypedConsumers summary) <> "; encoding=inherited-event-source",+      "  aggregate-command-payloads: " <> renderCounts ((.aggregateCommandPayloads) summary) <> "; encoding=consumer-build-only",+      "  private-event-payloads: " <> renderCounts ((.privateEventPayloads) summary),+      "  snapshot-registers: " <> renderCounts ((.snapshotRegisters) summary) <> "; encoding=consumer-json-cache; invalidation=tracked",+      "  queue-payloads: " <> renderCounts ((.workqueuePayloads) summary) <> "; encoding=queue-envelope-v1; migration=drain-or-transitional-codec",+      "  read-model-query-inputs: " <> renderCounts ((.readModelQueryInputs) summary) <> "; encoding=generated-haskell-api",+      "  read-model-query-results: " <> renderCounts ((.readModelQueryResults) summary) <> "; encoding=generated-haskell-api",+      "  projection-typed-consumers: " <> renderCounts ((.projectionTypedConsumers) summary) <> "; encoding=inherited-event-source",       "  public-contracts: not-applicable (separately owned grammar)"     ]   where-    summary = coverageSummary report+    summary = (.summary) report     renderCounts counts =-      T.pack (show (totalRoots counts))+      T.pack (show ((.totalRoots) counts))         <> " mapped roots ("-        <> T.pack (show (structuralRoots counts))+        <> T.pack (show ((.structuralRoots) counts))         <> " structural, "-        <> T.pack (show (opaqueRoots counts))+        <> T.pack (show ((.opaqueRoots) counts))         <> " opaque, "-        <> T.pack (show (jsonBoundaries counts))+        <> T.pack (show ((.jsonBoundaries) counts))         <> " Json boundaries)"  renderCoverageFinding :: FilePath -> CoverageFinding -> Text renderCoverageFinding specPath finding =   T.pack specPath     <> ":0: "-    <> severityText (findingSeverity finding)+    <> severityText ((.severity) finding)     <> "["-    <> T.pack (show (findingCode finding))+    <> T.pack (show ((.code) finding))     <> "]: "     <> coverageFindingMessage finding   where@@ -320,9 +338,9 @@ -- | The finding's message with its root list appended, shared by the rendered -- stderr line and the machine check-report entry so both say the same thing. coverageFindingMessage :: CoverageFinding -> Text-coverageFindingMessage finding = findingMessage finding <> rootsSuffix+coverageFindingMessage finding = (.message) finding <> rootsSuffix   where-    rootsSuffix = case findingRoots finding of+    rootsSuffix = case (.roots) finding of       [] -> ""       roots -> " (roots: " <> T.intercalate ", " roots <> ")" @@ -332,7 +350,7 @@   Aeson.encodeFile path report  persistedSites :: TypeGraph -> [UseSite]-persistedSites = filter isPersisted . tgUseSites+persistedSites = filter isPersisted . (.useSites)   where     isPersisted RootEventField {} = True     isPersisted RootRegister {} = True@@ -343,73 +361,73 @@  coverageRoot :: TypeGraph -> MappedRoot -> CoverageRoot coverageRoot graph mappedRoot =-  let site = mappedRootUseSite mappedRoot-      key = mappedRootDeclaration mappedRoot+  let site = (.useSite) mappedRoot+      key = (.declaration) mappedRoot       path = renderUsePath (UsePath site (useSiteSegments graph site))       fingerprint = wireFingerprint graph (unMappedKey key)-   in case Map.lookup key (tgDeclarations graph) of+   in case Map.lookup key ((.declarations) graph) of         Just (ResolvedStructural declaration _) ->           CoverageRoot-            { rootSurface = rootKindSurface (mappedRootKind mappedRoot),-              rootConsumer = mappedConsumerIdentity (mappedRootConsumer mappedRoot),-              rootPath = path,-              rootMappedType = unMappedKey key,-              rootMode = StructuralCoverage,-              rootCanonicalType = Just (unCanonicalTypeId (sdCanonical declaration)),-              rootCodecIdentity = Nothing,-              rootCodecVersion = Nothing,-              rootWireFingerprint = fingerprint+            { surface = rootKindSurface ((.kind) mappedRoot),+              consumer = mappedConsumerIdentity ((.consumer) mappedRoot),+              path = path,+              mappedType = unMappedKey key,+              mode = StructuralCoverage,+              canonicalType = Just (unCanonicalTypeId ((.canonical) declaration)),+              codecIdentity = Nothing,+              codecVersion = Nothing,+              wireFingerprint = fingerprint             }         Just (ResolvedOpaque declaration) ->           CoverageRoot-            { rootSurface = rootKindSurface (mappedRootKind mappedRoot),-              rootConsumer = mappedConsumerIdentity (mappedRootConsumer mappedRoot),-              rootPath = path,-              rootMappedType = unMappedKey key,-              rootMode = OpaqueCoverage,-              rootCanonicalType = Nothing,-              rootCodecIdentity = Just (unCodecIdentity (odCodecIdentity declaration)),-              rootCodecVersion = Just (unCodecVersion (odCodecVersion declaration)),-              rootWireFingerprint = fingerprint+            { surface = rootKindSurface ((.kind) mappedRoot),+              consumer = mappedConsumerIdentity ((.consumer) mappedRoot),+              path = path,+              mappedType = unMappedKey key,+              mode = OpaqueCoverage,+              canonicalType = Nothing,+              codecIdentity = Just (unCodecIdentity ((.codecIdentity) declaration)),+              codecVersion = Just (unCodecVersion ((.codecVersion) declaration)),+              wireFingerprint = fingerprint             }         Nothing -> error "coverageRoot: resolved use-site key missing from graph"  structuralBoundaryInventory :: TypeGraph -> [StructuralBoundary] structuralBoundaryInventory graph =   sortOn-    structuralPath+    (.path)     [ StructuralBoundary-        { structuralRoot = rootText (upRoot path),-          structuralPath = renderUsePath path,-          structuralMappedType = sdName declaration,-          structuralCanonicalType = unCanonicalTypeId (sdCanonical declaration),-          structuralWireFingerprint = wireFingerprint graph (sdName declaration)+        { root = rootText ((.root) path),+          path = renderUsePath path,+          mappedType = (.name) declaration,+          canonicalType = unCanonicalTypeId ((.canonical) declaration),+          wireFingerprint = wireFingerprint graph ((.name) declaration)         }-    | ResolvedStructural declaration _ <- Map.elems (tgDeclarations graph),-      path <- usePaths graph (sdName declaration),-      isWireSite (upRoot path)+    | ResolvedStructural declaration _ <- Map.elems ((.declarations) graph),+      path <- usePaths graph ((.name) declaration),+      isWireSite ((.root) path)     ]  opaqueBoundaryInventory :: TypeGraph -> [OpaqueBoundary] opaqueBoundaryInventory graph =   sortOn-    opaquePath+    (.path)     [ OpaqueBoundary-        { opaqueRoot = rootText (upRoot path),-          opaquePath = renderUsePath path,-          opaqueMappedType = odName declaration,-          opaqueCodecIdentity = unCodecIdentity (odCodecIdentity declaration),-          opaqueCodecVersion = unCodecVersion (odCodecVersion declaration)+        { root = rootText ((.root) path),+          path = renderUsePath path,+          mappedType = (.name) declaration,+          codecIdentity = unCodecIdentity ((.codecIdentity) declaration),+          codecVersion = unCodecVersion ((.codecVersion) declaration)         }-    | ResolvedOpaque declaration <- Map.elems (tgDeclarations graph),-      path <- usePaths graph (odName declaration),-      isWireSite (upRoot path)+    | ResolvedOpaque declaration <- Map.elems ((.declarations) graph),+      path <- usePaths graph ((.name) declaration),+      isWireSite ((.root) path)     ]  jsonBoundaryInventory :: TypeGraph -> [JsonBoundary] jsonBoundaryInventory graph =   sortOn-    jsonPath+    (.path)     [ boundary site completeSegments     | site <- persistedSites graph,       isWireSite site,@@ -419,23 +437,23 @@   where     boundary site segments =       JsonBoundary-        { jsonSurface = useSiteSurface site,-          jsonRoot = rootText site,-          jsonPath = renderUsePath (UsePath site segments)+        { surface = useSiteSurface site,+          root = rootText site,+          path = renderUsePath (UsePath site segments)         }  queueExplicitJsonBoundaries :: Spec -> [JsonBoundary] queueExplicitJsonBoundaries spec =   [ JsonBoundary-      { jsonSurface = WorkqueuePayload,-        jsonRoot = root,-        jsonPath = root <> renderSegments segments+      { surface = WorkqueuePayload,+        root = root,+        path = root <> renderSegments segments       }-  | NWorkqueue workqueue <- specNodes spec,-    field <- wqPayload workqueue,-    TypedQueueExpression expression <- [wqfType field],+  | NWorkqueue workqueue <- (.nodes) spec,+    field <- (.payload) workqueue,+    TypedQueueExpression expression <- [(.valueType) field],     segments <- explicitJsonPaths expression,-    let root = "workqueue " <> wqName workqueue <> " payload ." <> wqfName field+    let root = "workqueue " <> (.name) workqueue <> " payload ." <> (.name) field   ]   where     explicitJsonPaths TJson = [[]]@@ -456,31 +474,31 @@ snapshotBoundaryInventory :: Spec -> TypeGraph -> [SnapshotBoundary] snapshotBoundaryInventory spec graph =   sortOn-    snapshotRoot+    (.root)     [ SnapshotBoundary-        { snapshotRoot = renderUsePath (UsePath site []),-          snapshotAggregate = aggregate,-          snapshotRegister = register,-          snapshotMappedType = unMappedKey key,-          snapshotMode = declarationMode declaration,-          snapshotEncoding = "consumer-json-cache",-          snapshotInvalidation = "tracked-by-mapped-wire-fingerprint",-          snapshotWireFingerprint = wireFingerprint graph (unMappedKey key),-          snapshotEnabled = aggregateHasSnapshot aggregate+        { root = renderUsePath (UsePath site []),+          aggregate = aggregate,+          register = register,+          mappedType = unMappedKey key,+          mode = declarationMode declaration,+          encoding = "consumer-json-cache",+          invalidation = "tracked-by-mapped-wire-fingerprint",+          wireFingerprint = wireFingerprint graph (unMappedKey key),+          enabled = aggregateHasSnapshot aggregate         }     | site@(RootRegister aggregate register key) <- persistedSites graph,-      Just declaration <- [Map.lookup key (tgDeclarations graph)]+      Just declaration <- [Map.lookup key ((.declarations) graph)]     ]   where     aggregateHasSnapshot name =       any-        (\case NAggregate aggregate -> aggName aggregate == name && maybe False (const True) (aggSnapshot aggregate); _ -> False)-        (specNodes spec)+        (\case NAggregate aggregate -> (.name) aggregate == name && maybe False (const True) ((.snapshot) aggregate); _ -> False)+        ((.nodes) spec)  jsonPathsFromDecl :: TypeGraph -> Set.Set MappedKey -> MappedKey -> [[PathSeg]] jsonPathsFromDecl graph visited key   | key `Set.member` visited = []-  | otherwise = case Map.lookup key (tgDeclarations graph) of+  | otherwise = case Map.lookup key ((.declarations) graph) of       Nothing -> []       Just declaration ->         foldMappedDecl@@ -496,13 +514,13 @@     MappedShapeAlgebra       { onRecord = \_ _ fields ->           concat-            [ map (SegField (rwfHaskell field) (rwfKey field) :) (jsonPathsFromExpr graph visited (rwfType field))+            [ map (SegField ((.haskell) field) ((.key) field) :) (jsonPathsFromExpr graph visited ((.valueType) field))             | field <- fields             ],         onEnum = const [],         onUnion = \_ arms ->           concat-            [ map (SegArm (rwaCtor arm) (rwaTag arm) :) (maybe [] (jsonPathsFromExpr graph visited) (rwaPayload arm))+            [ map (SegArm ((.ctor) arm) ((.tag) arm) :) (maybe [] (jsonPathsFromExpr graph visited) ((.payload) arm))             | arm <- arms             ]       }@@ -537,49 +555,49 @@     }   where     countsFor surface =-      let matching = filter ((== surface) . rootSurface) roots-          jsonCount = length (filter ((== surface) . jsonSurface) json)+      let matching = filter ((== surface) . (.surface)) roots+          jsonCount = length (filter ((== surface) . (.surface)) json)        in CoverageCounts             { totalRoots = length matching,-              structuralRoots = length (filter ((== StructuralCoverage) . rootMode) matching),-              opaqueRoots = length (filter ((== OpaqueCoverage) . rootMode) matching),+              structuralRoots = length (filter ((== StructuralCoverage) . (.mode)) matching),+              opaqueRoots = length (filter ((== OpaqueCoverage) . (.mode)) matching),               jsonBoundaries = jsonCount             }  opaqueSurfaceFindings :: [OpaqueBoundary] -> [CoverageFinding] opaqueSurfaceFindings boundaries =   [ CoverageFinding-      { findingSeverity = Warning,-        findingCode = CoverageOpaqueSurface,-        findingRoots = [root],-        findingMessage = "persisted mapped root contains opaque mapped boundaries"+      { severity = Warning,+        code = CoverageOpaqueSurface,+        roots = [root],+        message = "persisted mapped root contains opaque mapped boundaries"       }-  | root <- Set.toAscList (Set.fromList (map opaqueRoot boundaries))+  | root <- Set.toAscList (Set.fromList (map (.root) boundaries))   ]  gateFinding :: Text -> [OpaqueBoundary] -> CoverageFinding gateFinding message boundaries =   CoverageFinding-    { findingSeverity = Error,-      findingCode = CoverageOpaqueGateExceeded,-      findingRoots = Set.toAscList (Set.fromList (map opaqueRoot boundaries)),-      findingMessage = message+    { severity = Error,+      code = CoverageOpaqueGateExceeded,+      roots = Set.toAscList (Set.fromList (map (.root) boundaries)),+      message = message     }  unsupportedInventory :: TypeGraph -> [UnsupportedSurface] unsupportedInventory graph =   [ UnsupportedSurface-      { unsupportedSurface = "public-contracts",-        unsupportedSupport = "not-applicable",-        unsupportedReason = "public contracts have a separately owned grammar and compatibility surface"+      { surface = "public-contracts",+        support = "not-applicable",+        reason = "public contracts have a separately owned grammar and compatibility surface"       }   ]     <> [ UnsupportedSurface-           { unsupportedSurface = unsupportedProjectionIdentity boundary,-             unsupportedSupport = "operational-only",-             unsupportedReason = "heterogeneous projection sources have no single generated event type or mapped declaration root"+           { surface = unsupportedProjectionIdentity boundary,+             support = "operational-only",+             reason = "heterogeneous projection sources have no single generated event type or mapped declaration root"            }-       | boundary <- tgUnsupportedProjectionSources graph+       | boundary <- (.unsupportedProjectionSources) graph        ]   where     unsupportedProjectionIdentity (UnsupportedCatalogCategory owner categoryName) = "projection-category:" <> owner <> ":" <> categoryName@@ -649,90 +667,90 @@ instance ToJSON CoverageRoot where   toJSON root =     object-      [ "surface" .= rootSurface root,-        "consumer" .= rootConsumer root,-        "path" .= rootPath root,-        "mappedType" .= rootMappedType root,-        "mode" .= rootMode root,-        "canonicalType" .= rootCanonicalType root,-        "codecIdentity" .= rootCodecIdentity root,-        "codecVersion" .= rootCodecVersion root,-        "wireFingerprint" .= rootWireFingerprint root+      [ "surface" .= (.surface) root,+        "consumer" .= (.consumer) root,+        "path" .= (.path) root,+        "mappedType" .= (.mappedType) root,+        "mode" .= (.mode) root,+        "canonicalType" .= (.canonicalType) root,+        "codecIdentity" .= (.codecIdentity) root,+        "codecVersion" .= (.codecVersion) root,+        "wireFingerprint" .= (.wireFingerprint) root       ]  instance ToJSON StructuralBoundary where   toJSON boundary =     object-      [ "root" .= structuralRoot boundary,-        "path" .= structuralPath boundary,-        "mappedType" .= structuralMappedType boundary,-        "canonicalType" .= structuralCanonicalType boundary,-        "wireFingerprint" .= structuralWireFingerprint boundary+      [ "root" .= (.root) boundary,+        "path" .= (.path) boundary,+        "mappedType" .= (.mappedType) boundary,+        "canonicalType" .= (.canonicalType) boundary,+        "wireFingerprint" .= (.wireFingerprint) boundary       ]  instance ToJSON OpaqueBoundary where   toJSON boundary =     object-      [ "root" .= opaqueRoot boundary,-        "path" .= opaquePath boundary,-        "mappedType" .= opaqueMappedType boundary,-        "codecIdentity" .= opaqueCodecIdentity boundary,-        "codecVersion" .= opaqueCodecVersion boundary+      [ "root" .= (.root) boundary,+        "path" .= (.path) boundary,+        "mappedType" .= (.mappedType) boundary,+        "codecIdentity" .= (.codecIdentity) boundary,+        "codecVersion" .= (.codecVersion) boundary       ]  instance ToJSON JsonBoundary where-  toJSON boundary = object ["surface" .= jsonSurface boundary, "root" .= jsonRoot boundary, "path" .= jsonPath boundary]+  toJSON boundary = object ["surface" .= (.surface) boundary, "root" .= (.root) boundary, "path" .= (.path) boundary]  instance ToJSON SnapshotBoundary where   toJSON boundary =     object-      [ "root" .= snapshotRoot boundary,-        "aggregate" .= snapshotAggregate boundary,-        "register" .= snapshotRegister boundary,-        "mappedType" .= snapshotMappedType boundary,-        "mode" .= snapshotMode boundary,-        "snapshotEncoding" .= snapshotEncoding boundary,-        "invalidation" .= snapshotInvalidation boundary,-        "wireFingerprint" .= snapshotWireFingerprint boundary,-        "snapshotEnabled" .= snapshotEnabled boundary+      [ "root" .= (.root) boundary,+        "aggregate" .= (.aggregate) boundary,+        "register" .= (.register) boundary,+        "mappedType" .= (.mappedType) boundary,+        "mode" .= (.mode) boundary,+        "snapshotEncoding" .= (.encoding) boundary,+        "invalidation" .= (.invalidation) boundary,+        "wireFingerprint" .= (.wireFingerprint) boundary,+        "snapshotEnabled" .= (.enabled) boundary       ]  instance ToJSON UnsupportedSurface where   toJSON surface =     object-      [ "surface" .= unsupportedSurface surface,-        "support" .= unsupportedSupport surface,-        "reason" .= unsupportedReason surface+      [ "surface" .= (.surface) surface,+        "support" .= (.support) surface,+        "reason" .= (.reason) surface       ]  instance ToJSON CoverageCounts where   toJSON counts =     object-      [ "totalRoots" .= totalRoots counts,-        "structuralRoots" .= structuralRoots counts,-        "opaqueRoots" .= opaqueRoots counts,-        "jsonBoundaries" .= jsonBoundaries counts+      [ "totalRoots" .= (.totalRoots) counts,+        "structuralRoots" .= (.structuralRoots) counts,+        "opaqueRoots" .= (.opaqueRoots) counts,+        "jsonBoundaries" .= (.jsonBoundaries) counts       ]  instance ToJSON CoverageSummary where   toJSON summary =     object-      [ "aggregateCommandPayloads" .= aggregateCommandPayloads summary,-        "privateEventPayloads" .= privateEventPayloads summary,-        "snapshotRegisters" .= snapshotRegisters summary,-        "workqueuePayloads" .= workqueuePayloads summary,-        "readModelQueryInputs" .= readModelQueryInputs summary,-        "readModelQueryResults" .= readModelQueryResults summary,-        "projectionTypedConsumers" .= projectionTypedConsumers summary+      [ "aggregateCommandPayloads" .= (.aggregateCommandPayloads) summary,+        "privateEventPayloads" .= (.privateEventPayloads) summary,+        "snapshotRegisters" .= (.snapshotRegisters) summary,+        "workqueuePayloads" .= (.workqueuePayloads) summary,+        "readModelQueryInputs" .= (.readModelQueryInputs) summary,+        "readModelQueryResults" .= (.readModelQueryResults) summary,+        "projectionTypedConsumers" .= (.projectionTypedConsumers) summary       ]  instance ToJSON CoverageFinding where   toJSON finding =     object-      [ "severity" .= severityValue (findingSeverity finding),-        "code" .= show (findingCode finding),-        "roots" .= findingRoots finding,-        "message" .= findingMessage finding+      [ "severity" .= severityValue ((.severity) finding),+        "code" .= show ((.code) finding),+        "roots" .= (.roots) finding,+        "message" .= (.message) finding       ]     where       -- One severity vocabulary across every keiro-dsl JSON report. The check@@ -744,39 +762,39 @@ instance ToJSON CoveragePrevious where   toJSON previous =     object-      [ "reference" .= previousReference previous,-        "summary" .= previousSummary previous,-        "opaqueBoundaries" .= previousOpaqueBoundaries previous+      [ "reference" .= (.reference) previous,+        "summary" .= (.summary) previous,+        "opaqueBoundaries" .= (.opaqueBoundaries) previous       ]  instance ToJSON CoverageDelta where   toJSON delta =     object-      [ "aggregateCommandRootDelta" .= aggregateCommandRootDelta delta,-        "privateEventRootDelta" .= privateEventRootDelta delta,-        "snapshotRegisterRootDelta" .= snapshotRegisterRootDelta delta,-        "workqueuePayloadRootDelta" .= workqueuePayloadRootDelta delta,-        "readModelQueryInputRootDelta" .= readModelQueryInputRootDelta delta,-        "readModelQueryResultRootDelta" .= readModelQueryResultRootDelta delta,-        "projectionTypedConsumerRootDelta" .= projectionTypedConsumerRootDelta delta,-        "opaqueBoundaryDelta" .= opaqueBoundaryDelta delta,-        "addedOpaqueBoundaries" .= addedOpaqueBoundaries delta,-        "removedOpaqueBoundaries" .= removedOpaqueBoundaries delta+      [ "aggregateCommandRootDelta" .= (.aggregateCommandRootDelta) delta,+        "privateEventRootDelta" .= (.privateEventRootDelta) delta,+        "snapshotRegisterRootDelta" .= (.snapshotRegisterRootDelta) delta,+        "workqueuePayloadRootDelta" .= (.workqueuePayloadRootDelta) delta,+        "readModelQueryInputRootDelta" .= (.readModelQueryInputRootDelta) delta,+        "readModelQueryResultRootDelta" .= (.readModelQueryResultRootDelta) delta,+        "projectionTypedConsumerRootDelta" .= (.projectionTypedConsumerRootDelta) delta,+        "opaqueBoundaryDelta" .= (.opaqueBoundaryDelta) delta,+        "addedOpaqueBoundaries" .= (.addedOpaqueBoundaries) delta,+        "removedOpaqueBoundaries" .= (.removedOpaqueBoundaries) delta       ]  instance ToJSON CoverageReport where   toJSON report =     object       [ "schema" .= ("keiro-dsl/coverage-report/1" :: Text),-        "spec" .= coverageSpec report,-        "roots" .= coverageRoots report,-        "structuralBoundaries" .= coverageStructuralBoundaries report,-        "opaqueBoundaries" .= coverageOpaqueBoundaries report,-        "jsonBoundaries" .= coverageJsonBoundaries report,-        "snapshotBoundaries" .= coverageSnapshotBoundaries report,-        "unsupportedSurfaces" .= coverageUnsupportedSurfaces report,-        "summary" .= coverageSummary report,-        "findings" .= coverageFindings report,-        "previous" .= coveragePrevious report,-        "delta" .= coverageDelta report+        "spec" .= (.spec) report,+        "roots" .= (.roots) report,+        "structuralBoundaries" .= (.structuralBoundaries) report,+        "opaqueBoundaries" .= (.opaqueBoundaries) report,+        "jsonBoundaries" .= (.jsonBoundaries) report,+        "snapshotBoundaries" .= (.snapshotBoundaries) report,+        "unsupportedSurfaces" .= (.unsupportedSurfaces) report,+        "summary" .= (.summary) report,+        "findings" .= (.findings) report,+        "previous" .= (.previous) report,+        "delta" .= (.delta) report       ]

src/Keiro/Dsl/Diff.hs view

@@ -22,3024 +22,3098 @@     MappedPersistedSurface (..),     MappedPersistedImpact (..),     ChangeContext,-    privateEventContext,-    privateEventAdditionContext,-    snapshotContext,-    queueContext,-    publicContractContext,-    persistedIdentityContext,-    consumerBuildContext,-    advisoryAt,-    changeContextRoot,-    changeContextPaths,-    classifyCompatibility,-    verdictFor,-    defaultGate,-    gateWith,-    deriveLabel,-    gatedBreaking,-    isBreaking,-    isAdvisory,-    diffSources,-    sourceLanguageChange,-    diffServices,-    mappedSemanticImpact,-    mappedSemanticImpactForServices,-    DiffEnv (..),-    NodeFamily (..),-    familyOf,-    FamilyDiff (..),-    familyRegistry,-    Paired (..),-    pairByName,-    readModelDiff,-    classifyWorkflowBody,-  )-where--import Data.Char (toUpper)-import Data.Foldable (traverse_)-import Data.List (find, sort, (\\))-import Data.Map.Strict qualified as Map-import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)-import Data.Set (Set)-import Data.Set qualified as Set-import Data.Text (Text)-import Data.Text qualified as T-import Keiro.Dsl.AggregateType (typeExprCanonicalName)-import Keiro.Dsl.CanonicalEncoding (canonicalDomainOutcomeTypes, canonicalTransition, canonicalTransitionOutcome)-import Keiro.Dsl.FieldIdentity-  ( ResolvedFieldIdentity (..),-    resolveAggregateFieldIdentity,-    resolveContractFieldIdentity,-  )-import Keiro.Dsl.FoldFingerprint (FoldSurfaceError, aggregateFoldSurfaceForService)-import Keiro.Dsl.Grammar-import Keiro.Dsl.HaskellName qualified as HaskellName-import Keiro.Dsl.IdDomain (IdDomainContract (..), contractIdDomainContractFor, idDomainContractFor)-import Keiro.Dsl.LanguageVersion (ParsedSource (..), SourceLanguage, declaredLanguageVersionMaybe, languageVersionText, sourceFormText)-import Keiro.Dsl.MappedDiff (MappedFinding (..), diffMapped, renderMappedSubject)-import Keiro.Dsl.PrettyPrint-  ( renderHandleSurface,-    renderResolveSurface,-    renderRouterDispatchSurface,-    renderTimerPayloadSurface,-    renderTransition,-    renderTypeExpr,-  )-import Keiro.Dsl.ProjectionMappedImpact qualified as ProjectionImpact-import Keiro.Dsl.ProjectionSupply-import Keiro.Dsl.ReadModelShape (registryNameFor, subscriptionNameFor)-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedSource, checkedSpec, effectiveLanguageContract, effectiveRuntimeSemantics, legacyCheckedService)-import Keiro.Dsl.SemanticImpact (MappedConsequence (..), MappedConsumer (..), MappedImpactDelta (..), MappedQueryPosition (..), diffSemanticImpact, mappedConsumerIdentity, mappedImpactForDeclarations, semanticImpact, semanticImpactForService, semanticImpactSnapshot)-import Keiro.Dsl.TypeGraph (DerivedMappedConsumer (..), MappedKey (..), UsePath (..), UseSite (..), renderUsePath, resolveTypeGraph)-import Keiro.Dsl.Validate (DiagnosticCode (..))---- | A classified spec change.-data Change-  = Additive ChangeKind-  | Advisory ChangeKind-  | Breaking ChangeKind-  deriving stock (Eq, Show)---- | The stable headline classification retained by the text interface.-data Label = LabelAdditive | LabelAdvisory | LabelBreaking-  deriving stock (Eq, Show)---- | Independently gateable compatibility questions for one finding.-data CompatibilitySurface-  = PrivateHistoryRead-  | OldBinaryReadNewEvents-  | SnapshotHydration-  | PublicConsumer-  | PersistedIdentity-  | ConsumerBuild-  deriving stock (Eq, Ord, Show, Enum, Bounded)---- | A verdict on one surface.  Constructor order is deliberately not policy.-data SurfaceVerdict = VCompatible | VAdvisory | VBreaking | VNotApplicable-  deriving stock (Eq, Show)---- | Deployment ordering that remains after byte compatibility is classified.-data RolloutConstraint-  = RolloutStopTheWorld-  | RolloutWorkersFirst-  | RolloutDrainRequired-  | RolloutProducerLast-  | RolloutProducerFirst-  deriving stock (Eq, Ord, Show)---- | The explicit, compile-forcing compatibility result for one finding.-data CompatibilityVector = CompatibilityVector-  { cvPrivateHistoryRead :: !SurfaceVerdict,-    cvOldBinaryReadNewEvents :: !SurfaceVerdict,-    cvSnapshotHydration :: !SurfaceVerdict,-    cvPublicConsumer :: !SurfaceVerdict,-    cvPersistedIdentity :: !SurfaceVerdict,-    cvConsumerBuild :: !SurfaceVerdict,-    cvRollout :: !(Set RolloutConstraint)-  }-  deriving stock (Eq, Show)---- | Persisted mapped payloads that must not be conflated merely because the--- compatibility vector predates first-class queue history.-data MappedPersistedSurface-  = PrivateEventHistory-  | SnapshotCache-  | WorkqueueHistory !Name-  deriving stock (Eq, Ord, Show)--data MappedPersistedImpact = MappedPersistedImpact-  { mappedPersistedSurface :: !MappedPersistedSurface,-    mappedPersistedVerdict :: !SurfaceVerdict-  }-  deriving stock (Eq, Show)--data ContextKind-  = ContextGeneral-  | ContextPrivateEvent-  | ContextPrivateEventAddition-  | ContextSnapshot-  | ContextQueue-  | ContextPublicContract-  | ContextPersistedIdentity-  | ContextConsumerBuild-  deriving stock (Eq, Show)---- | Facts that select a compatibility row.  The constructor stays private so--- callers cannot manufacture contradictory ownership and surface claims.-data ChangeContext = ChangeContext-  { changeContextRoot :: !Name,-    changeContextPaths :: ![Text],-    contextKind :: !ContextKind,-    contextOriginalLabel :: !Label-  }-  deriving stock (Eq, Show)--data ChangeKind = ChangeKind-  { ckNode :: !Name,-    ckFacet :: !Text,-    ckSubject :: !Text,-    ckCode :: !DiagnosticCode,-    ckContext :: !ChangeContext,-    ckVector :: !CompatibilityVector,-    ckMappedPersistedImpact :: !(Maybe MappedPersistedImpact),-    ckMappedConsequences :: !(Set MappedConsequence),-    ckPaths :: ![Text],-    ckDetail :: !Text-  }-  deriving stock (Eq, Show)--privateEventContext :: Name -> [Text] -> ChangeContext-privateEventContext root paths = ChangeContext root paths ContextPrivateEvent LabelBreaking--privateEventAdditionContext :: Name -> [Text] -> ChangeContext-privateEventAdditionContext root paths = ChangeContext root paths ContextPrivateEventAddition LabelAdvisory--snapshotContext :: Name -> [Text] -> ChangeContext-snapshotContext root paths = ChangeContext root paths ContextSnapshot LabelAdvisory--queueContext :: Name -> [Text] -> ChangeContext-queueContext root paths = ChangeContext root paths ContextQueue LabelBreaking--publicContractContext :: Name -> [Text] -> ChangeContext-publicContractContext root paths = ChangeContext root paths ContextPublicContract LabelBreaking--persistedIdentityContext :: Name -> [Text] -> ChangeContext-persistedIdentityContext root paths = ChangeContext root paths ContextPersistedIdentity LabelBreaking--consumerBuildContext :: Name -> [Text] -> ChangeContext-consumerBuildContext root paths = ChangeContext root paths ContextConsumerBuild LabelAdvisory--compatibleVector :: CompatibilityVector-compatibleVector =-  CompatibilityVector-    VCompatible-    VCompatible-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VNotApplicable-    Set.empty--sourceProvenanceVector :: CompatibilityVector-sourceProvenanceVector =-  CompatibilityVector-    VCompatible-    VCompatible-    VCompatible-    VCompatible-    VCompatible-    VCompatible-    Set.empty--privateDecodeBreakingVector :: CompatibilityVector-privateDecodeBreakingVector =-  CompatibilityVector-    VBreaking-    VBreaking-    VAdvisory-    VNotApplicable-    VNotApplicable-    VNotApplicable-    (Set.singleton RolloutStopTheWorld)--persistedIdentityBreakingVector :: CompatibilityVector-persistedIdentityBreakingVector =-  CompatibilityVector-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VBreaking-    VNotApplicable-    Set.empty--publicBreakingVector :: CompatibilityVector-publicBreakingVector =-  CompatibilityVector-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VBreaking-    VNotApplicable-    VNotApplicable-    (Set.singleton RolloutProducerLast)--queueBreakingVector :: CompatibilityVector-queueBreakingVector =-  CompatibilityVector-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VBreaking-    (Set.fromList [RolloutWorkersFirst, RolloutDrainRequired])--catalogCheckpointPolicyVector :: CompatibilityVector-catalogCheckpointPolicyVector =-  CompatibilityVector-    VCompatible-    VCompatible-    VNotApplicable-    VNotApplicable-    VCompatible-    VBreaking-    (Set.singleton RolloutStopTheWorld)--advisoryVector :: CompatibilitySurface -> Set RolloutConstraint -> CompatibilityVector-advisoryVector surface rollout =-  compatibleVector-    { cvPrivateHistoryRead = verdict PrivateHistoryRead,-      cvOldBinaryReadNewEvents = verdict OldBinaryReadNewEvents,-      cvSnapshotHydration = verdict SnapshotHydration,-      cvPublicConsumer = verdict PublicConsumer,-      cvPersistedIdentity = verdict PersistedIdentity,-      cvConsumerBuild = verdict ConsumerBuild,-      cvRollout = rollout-    }-  where-    verdict candidate-      | candidate == surface = VAdvisory-      | otherwise = verdictFor candidate compatibleVector---- | Classify one code at an explicitly owned use site.  Codes emitted by the--- differ are grouped by their actual persisted/public surface; the context is--- load-bearing for codes such as 'EnumCtorAdded' that vary by use site.-classifyCompatibility :: ChangeContext -> DiagnosticCode -> CompatibilityVector-classifyCompatibility context code-  | code == SourceLanguageDeclarationChanged = sourceProvenanceVector-  | code == GeneratedHaskellNameChanged = sourceProvenanceVector {cvConsumerBuild = VAdvisory}-  | code `elem` [OwnershipMoved, WorkspaceAuthorityChanged] = mappedBuildVector-  | code `elem` [ReadModelQueryInputChanged, ReadModelQueryResultChanged] =-      compatibleVector {cvConsumerBuild = VBreaking}-  | code == MappedFieldAddedWithDefault = mappedFieldAdditionVector context-  | code `elem` [MappedArmAdded, MappedEnumValueAdded] = mappedDirectionalAdditionVector context-  | code `elem` mappedWireBreakingCodes = mappedWireBreakingVector context-  | code `elem` [MappedHaskellSourceChanged, MappedRecordConstructorChanged, MappedFixturesChanged] = mappedBuildVector-  | code == MappedBindingChanged = mappedBindingVector context-  | code `elem` [MappedInitialChanged, MappedCanonicalTypeChanged] = mappedSnapshotBuildVector context-  | code == NominalFixturesChanged = mappedBuildVector-  | code == NominalBindingChanged = mappedBindingVector context-  | code `elem` [NominalInitialChanged, NominalCanonicalTypeChanged] = mappedSnapshotBuildVector context-  | code == NominalRepresentationChanged = mappedWireBreakingVector context-  | code == NominalIdDecoderTightened =-      (advisoryVector PrivateHistoryRead Set.empty) {cvConsumerBuild = VAdvisory}-  | code == ContractTypeIdDomainChanged = contractTypeIdDomainVector-  | code == IdDomainContractChanged = idDomainContractVector-  | code == MappedDeclAdded = compatibleVector-  | code `elem` privateDecodeCodes = privateDecodeBreakingVector-  | code `elem` identityCodes = persistedIdentityBreakingVector-  | code `elem` publicBreakingCodes = publicBreakingVector-  | code `elem` queueBreakingCodes = queueBreakingVector-  | code `elem` readModelBreakingCodes = persistedIdentityBreakingVector-  | code `elem` catalogIdentityCodes = persistedIdentityBreakingVector-  | code `elem` catalogReplayCodes = privateDecodeBreakingVector-  | code == CatalogCheckpointPolicyChanged = catalogCheckpointPolicyVector-  | code `elem` [ProjectionDeliveryChanged, QueryFreshnessChanged] = persistedIdentityBreakingVector-  | code == CatalogHandlerOrderChanged =-      (advisoryVector PrivateHistoryRead Set.empty) {cvConsumerBuild = VAdvisory}-  | code == ContractSchemaVersionBumped = advisoryVector PublicConsumer (Set.singleton RolloutProducerLast)-  | code == AggFoldSurfaceChanged =-      (advisoryVector PrivateHistoryRead Set.empty) {cvSnapshotHydration = VAdvisory}-  | code == AggGuardTightened = advisoryVector PrivateHistoryRead Set.empty-  | code `elem` [RouterDecideSurfaceChanged, ProcessDecideSurfaceChanged] =-      compatibleVector {cvRollout = Set.singleton RolloutDrainRequired}-  | code == ProcessTimerPayloadChanged = advisoryVector PrivateHistoryRead (Set.singleton RolloutProducerLast)-  | code == TimerWindowChanged = advisoryVector PrivateHistoryRead Set.empty-  | code == ProjectionChanged = advisoryVector PersistedIdentity Set.empty-  | code == EmitMappingChanged = advisoryVector PublicConsumer (Set.singleton RolloutProducerLast)-  | code == DecodePostureChanged = advisoryVector PublicConsumer Set.empty-  | code == IntakePersistenceChanged = advisoryVector PrivateHistoryRead Set.empty-  | code `elem` [PublisherPolicyChanged, DispatchRetargeted] = advisoryVector PersistedIdentity Set.empty-  | code `elem` [DeprecatedEventReplayHazard, EventRetirementInProgress] = advisoryVector PrivateHistoryRead Set.empty-  | code == EventUndeprecated = advisoryVector OldBinaryReadNewEvents (Set.singleton RolloutProducerLast)-  | code == EnumCtorAdded = case contextKind context of-      ContextPrivateEventAddition ->-        compatibleVector-          { cvOldBinaryReadNewEvents = VBreaking,-            cvRollout = Set.singleton RolloutProducerLast-          }-      ContextSnapshot -> advisoryVector SnapshotHydration Set.empty-      _ -> compatibleVector-  | code `elem` additiveCodes = compatibleVector-  | otherwise = case contextOriginalLabel context of-      LabelAdditive -> compatibleVector-      LabelAdvisory -> advisoryVector (surfaceForContext context) Set.empty-      LabelBreaking -> breakingVectorForContext context-  where-    privateDecodeCodes =-      [ EvtFieldAddedWithoutBump,-        EvtFieldRemovedSameVersion,-        EvtFieldWireKeyChanged,-        EvtFieldTypeChanged,-        EvtVersionDecreased,-        EvtVersionMissingUpcaster,-        UpcasterChainGap,-        EvtRemovedNotDeprecated,-        EnumCtorRemoved,-        EnumWireSpellingChanged,-        WireSpecChanged,-        ProcessInputChanged,-        WorkflowShapeChanged,-        WorkflowBodyChanged,-        WorkflowPatchRemoved,-        WorkflowContinueSeedChanged-      ]--    identityCodes =-      [ DerivedIdentityChanged,-        IdPrefixChanged,-        DedupeIdentityChanged,-        QueueIdentityChanged,-        RouterStableNameChanged,-        WorkflowStableNameChanged-      ]-    publicBreakingCodes =-      [ ContractEventRemoved,-        ContractFieldChanged,-        ContractDiscriminatorChanged,-        ContractTopicChanged,-        ContractSchemaVersionDecreased-      ]-    queueBreakingCodes = [WqPayloadFieldChanged, WqOrderingChanged, WqProvisionChanged, WqGroupKeyChanged]-    readModelBreakingCodes =-      [ ReadModelVersionDecreased,-        ReadModelShapeChangedWithoutBump,-        ReadModelFeedChanged,-        ReadModelConsistencyWeakened-      ]-    catalogIdentityCodes =-      [ CatalogTargetRemoved,-        CatalogTargetLocationChanged,-        CatalogTargetDependencyChanged,-        CatalogGroupChanged,-        CatalogOwnerRemoved,-        CatalogFeedIdentityChanged,-        CatalogQueryBindingChanged,-        ProjectionDeliveryChanged,-        QueryFreshnessChanged-      ]-    catalogReplayCodes = [CatalogSourceChanged, CatalogReplayPolicyChanged]-    additiveCodes =-      [ DeclarationAdded,-        VersionBumped,-        CompatibilityStrengthened,-        EventRetirementAbandoned,-        ContractEventAdded,-        ContractTopicAdded,-        WorkflowEvolutionGuardAdded-      ]--idDomainContractVector :: CompatibilityVector-idDomainContractVector =-  CompatibilityVector-    { cvPrivateHistoryRead = VCompatible,-      cvOldBinaryReadNewEvents = VCompatible,-      cvSnapshotHydration = VAdvisory,-      cvPublicConsumer = VBreaking,-      cvPersistedIdentity = VCompatible,-      cvConsumerBuild = VAdvisory,-      cvRollout = Set.singleton RolloutProducerLast-    }--contractTypeIdDomainVector :: CompatibilityVector-contractTypeIdDomainVector =-  CompatibilityVector-    { cvPrivateHistoryRead = VNotApplicable,-      cvOldBinaryReadNewEvents = VNotApplicable,-      cvSnapshotHydration = VNotApplicable,-      cvPublicConsumer = VBreaking,-      cvPersistedIdentity = VNotApplicable,-      cvConsumerBuild = VBreaking,-      cvRollout = Set.fromList [RolloutDrainRequired, RolloutProducerFirst]-    }--mappedWireBreakingCodes :: [DiagnosticCode]-mappedWireBreakingCodes =-  [ MappedFieldAddedNoDefault,-    MappedFieldRemoved,-    MappedFieldTypeChanged,-    MappedPresenceChanged,-    MappedNullabilityChanged,-    MappedDefaultRemoved,-    MappedDefaultChanged,-    MappedWireKeyChanged,-    MappedUnionEncodingChanged,-    MappedArmRemoved,-    MappedArmTagChanged,-    MappedEnumValueRemoved,-    MappedEnumSpellingChanged,-    MappedOpaqueCodecChanged,-    MappedModeCrossed,-    MappedDeclRemoved-  ]--mappedFieldAdditionVector :: ChangeContext -> CompatibilityVector-mappedFieldAdditionVector context = case contextKind context of-  ContextPrivateEvent ->-    compatibleVector-      { cvOldBinaryReadNewEvents = oldBinaryVerdict,-        cvRollout = rollout-      }-    where-      rejectsUnknown = contextOriginalLabel context == LabelBreaking-      oldBinaryVerdict = if rejectsUnknown then VBreaking else VCompatible-      rollout = if rejectsUnknown then Set.singleton RolloutProducerLast else Set.empty-  ContextSnapshot -> mappedSnapshotVector-  ContextQueue -> queueBreakingVector-  ContextConsumerBuild -> mappedBuildVector-  _ -> compatibleVector--mappedDirectionalAdditionVector :: ChangeContext -> CompatibilityVector-mappedDirectionalAdditionVector context = case contextKind context of-  ContextPrivateEvent ->-    compatibleVector-      { cvOldBinaryReadNewEvents = VBreaking,-        cvRollout = Set.singleton RolloutProducerLast-      }-  ContextSnapshot -> mappedSnapshotVector-  ContextQueue -> queueBreakingVector-  ContextConsumerBuild -> mappedBuildVector-  _ -> compatibleVector--mappedWireBreakingVector :: ChangeContext -> CompatibilityVector-mappedWireBreakingVector context = case contextKind context of-  ContextPrivateEvent ->-    CompatibilityVector-      VBreaking-      VBreaking-      VNotApplicable-      VNotApplicable-      VNotApplicable-      VNotApplicable-      (Set.singleton RolloutStopTheWorld)-  ContextSnapshot -> mappedSnapshotVector-  ContextQueue -> queueBreakingVector-  ContextConsumerBuild -> mappedBuildVector-  _ -> mappedBuildVector--mappedBuildVector :: CompatibilityVector-mappedBuildVector =-  CompatibilityVector-    VCompatible-    VCompatible-    VNotApplicable-    VNotApplicable-    VNotApplicable-    VAdvisory-    Set.empty--mappedSnapshotVector :: CompatibilityVector-mappedSnapshotVector =-  CompatibilityVector-    VCompatible-    VCompatible-    VAdvisory-    VNotApplicable-    VNotApplicable-    VNotApplicable-    Set.empty--mappedBindingVector :: ChangeContext -> CompatibilityVector-mappedBindingVector context = case contextKind context of-  ContextPrivateEvent ->-    CompatibilityVector-      VAdvisory-      VAdvisory-      VNotApplicable-      VNotApplicable-      VNotApplicable-      VAdvisory-      Set.empty-  ContextSnapshot ->-    mappedSnapshotVector {cvConsumerBuild = VAdvisory}-  ContextQueue -> queueBreakingVector-  _ -> mappedBuildVector--mappedSnapshotBuildVector :: ChangeContext -> CompatibilityVector-mappedSnapshotBuildVector context = case contextKind context of-  ContextSnapshot -> mappedSnapshotVector {cvConsumerBuild = VAdvisory}-  _ -> mappedBuildVector--surfaceForContext :: ChangeContext -> CompatibilitySurface-surfaceForContext context = case contextKind context of-  ContextPrivateEvent -> PrivateHistoryRead-  ContextPrivateEventAddition -> OldBinaryReadNewEvents-  ContextSnapshot -> SnapshotHydration-  ContextQueue -> PrivateHistoryRead-  ContextPublicContract -> PublicConsumer-  ContextPersistedIdentity -> PersistedIdentity-  ContextConsumerBuild -> ConsumerBuild-  ContextGeneral -> PrivateHistoryRead--breakingVectorForContext :: ChangeContext -> CompatibilityVector-breakingVectorForContext context = case contextKind context of-  ContextPublicContract -> publicBreakingVector-  ContextPersistedIdentity -> persistedIdentityBreakingVector-  ContextQueue -> queueBreakingVector-  ContextConsumerBuild -> (advisoryVector ConsumerBuild Set.empty) {cvConsumerBuild = VBreaking}-  _ -> privateDecodeBreakingVector--verdictFor :: CompatibilitySurface -> CompatibilityVector -> SurfaceVerdict-verdictFor surface vector = case surface of-  PrivateHistoryRead -> cvPrivateHistoryRead vector-  OldBinaryReadNewEvents -> cvOldBinaryReadNewEvents vector-  SnapshotHydration -> cvSnapshotHydration vector-  PublicConsumer -> cvPublicConsumer vector-  PersistedIdentity -> cvPersistedIdentity vector-  ConsumerBuild -> cvConsumerBuild vector--defaultGate :: Set CompatibilitySurface-defaultGate = Set.delete OldBinaryReadNewEvents (Set.fromList [minBound .. maxBound])--gateWith :: [CompatibilitySurface] -> Set CompatibilitySurface-gateWith surfaces = defaultGate <> Set.fromList surfaces--deriveLabel :: Set CompatibilitySurface -> CompatibilityVector -> Label-deriveLabel gate vector-  | any ((== VBreaking) . (`verdictFor` vector)) (Set.toList gate) = LabelBreaking-  | any (`elem` [VAdvisory, VBreaking]) verdicts || not (Set.null (cvRollout vector)) = LabelAdvisory-  | otherwise = LabelAdditive-  where-    verdicts = [verdictFor surface vector | surface <- [minBound .. maxBound]]--gatedBreaking :: Set CompatibilitySurface -> Change -> Bool-gatedBreaking gate change = deriveLabel gate (ckVector (changeKind change)) == LabelBreaking--changeKind :: Change -> ChangeKind-changeKind (Additive kind) = kind-changeKind (Advisory kind) = kind-changeKind (Breaking kind) = kind--isBreaking :: Change -> Bool-isBreaking (Breaking _) = True-isBreaking (Additive _) = False-isBreaking (Advisory _) = False--isAdvisory :: Change -> Bool-isAdvisory (Advisory _) = True-isAdvisory (Additive _) = False-isAdvisory (Breaking _) = False---- | Both specs supplied to a node-family differ, always old then new.-data DiffEnv = DiffEnv-  { deOld :: !Spec,-    deNew :: !Spec-  }-  deriving stock (Eq, Show)---- | The closed set of node families currently present in 'Node'.-data NodeFamily-  = FamAggregate-  | FamProcess-  | FamRouter-  | FamContract-  | FamIntake-  | FamEmit-  | FamPublisher-  | FamWorkqueue-  | FamPgmqDispatch-  | FamReadModel-  | FamProjectionTarget-  | FamRebuildGroup-  | FamProjectionRevision-  | FamExternalRead-  | FamProjectionOwner-  | FamWorkflow-  | FamOperation-  deriving stock (Eq, Ord, Show, Enum, Bounded)---- | Total by construction: one explicit arm per 'Node' constructor.-familyOf :: Node -> NodeFamily-familyOf (NAggregate _) = FamAggregate-familyOf (NProcess _) = FamProcess-familyOf (NRouter _) = FamRouter-familyOf (NContract _) = FamContract-familyOf (NIntake _) = FamIntake-familyOf (NEmit _) = FamEmit-familyOf (NPublisher _) = FamPublisher-familyOf (NWorkqueue _) = FamWorkqueue-familyOf (NPgmqDispatch _) = FamPgmqDispatch-familyOf (NReadModel _) = FamReadModel-familyOf (NProjectionTarget _) = FamProjectionTarget-familyOf (NRebuildGroup _) = FamRebuildGroup-familyOf (NProjectionRevision _) = FamProjectionRevision-familyOf (NExternalRead _) = FamExternalRead-familyOf (NProjectionOwner _) = FamProjectionOwner-familyOf (NWorkflow _) = FamWorkflow-familyOf (NOperation _) = FamOperation---- | A family either has a differ or an explicit reason it is not compared.-data FamilyDiff-  = DiffFamily (DiffEnv -> [Change])-  | OutOfDiffScope Text---- | Pair the old and new declarations of one node family by stable name.-data Paired n = Paired-  { prMatched :: ![(n, n)],-    prAdded :: ![n],-    prRemoved :: ![n]-  }-  deriving stock (Eq, Show)--pairByName :: (Node -> Maybe n) -> (n -> Name) -> DiffEnv -> Paired n-pairByName project nameOf env =-  Paired-    { prMatched =-        [ (oldNode, newNode)-        | newNode <- newNodes,-          Just oldNode <- [find ((== nameOf newNode) . nameOf) oldNodes]-        ],-      prAdded =-        [ newNode-        | newNode <- newNodes,-          isNothing (find ((== nameOf newNode) . nameOf) oldNodes)-        ],-      prRemoved =-        [ oldNode-        | oldNode <- oldNodes,-          isNothing (find ((== nameOf oldNode) . nameOf) newNodes)-        ]-    }-  where-    oldNodes = mapMaybe project (specNodes (deOld env))-    newNodes = mapMaybe project (specNodes (deNew env))---- | Registry invariant: every 'Node' constructor maps to a family via the--- total 'familyOf' case, and every family occurs exactly once here.  The unit--- suite enforces registry coverage and non-empty out-of-scope rationales.-familyRegistry :: [(NodeFamily, FamilyDiff)]-familyRegistry =-  [ (FamAggregate, DiffFamily aggregateDiff),-    (FamProcess, DiffFamily processDiff),-    (FamRouter, DiffFamily routerDiff),-    (FamContract, DiffFamily contractDiff),-    (FamIntake, DiffFamily intakeDiff),-    (FamEmit, DiffFamily emitDiff),-    (FamPublisher, DiffFamily publisherDiff),-    (FamWorkqueue, DiffFamily workqueueDiff),-    (FamPgmqDispatch, DiffFamily pgmqDispatchDiff),-    (FamReadModel, DiffFamily readModelDiff),-    (FamProjectionTarget, DiffFamily projectionTargetDiff),-    (FamRebuildGroup, DiffFamily rebuildGroupDiff),-    (FamProjectionRevision, DiffFamily projectionRevisionDiff),-    (FamExternalRead, DiffFamily externalReadDiff),-    (FamProjectionOwner, DiffFamily projectionOwnerDiff),-    (FamWorkflow, DiffFamily workflowDiff),-    (FamOperation, OutOfDiffScope "operations own no persisted decode or identity surface; their references and workflow signal/await pairing are single-spec validation concerns")-  ]---- | Compare two graphs under their effective semantic contracts. The ordinary--- graph differ runs first; service-aware admission and fold findings then expose--- semantic-profile changes that leave the normalized graph itself unchanged.-diffServices :: CheckedService -> CheckedService -> Either FoldSurfaceError [Change]-diffServices oldService newService = do-  traverse_ (aggregateFoldSurfaceForService oldService . snd) oldAggregates-  traverse_ (aggregateFoldSurfaceForService newService . snd) newAggregates-  semanticContractFoldChanges <- fmap concat (traverse semanticContractFoldChange oldAggregates)-  pure (diffCheckedSpecs oldSpec newSpec <> idDomainContractChanges <> contractTypeIdDomainChanges <> semanticContractFoldChanges)-  where-    oldSpec = checkedSpec oldService-    newSpec = checkedSpec newService-    oldAggregates = [(aggName aggregate, aggregate) | NAggregate aggregate <- specNodes oldSpec]-    newAggregates = [(aggName aggregate, aggregate) | NAggregate aggregate <- specNodes newSpec]-    idDomainContractChanges =-      [ breaking-          (idName newDeclaration)-          "id-domain-contract"-          (idName newDeclaration)-          IdDomainContractChanged-          ( "ID admission contract changed "-              <> renderIdDomainContract oldContract-              <> " -> "-              <> renderIdDomainContract newContract-              <> "; public construction, command decoding, current JSON codecs, and literals use the new contract; historical event replay retains its legacy decoder; old snapshots miss and rebuild from readable events, while rebuilt state that still contains legacy-invalid text remains intentionally uncacheable until overwritten or explicitly migrated"-          )-      | newDeclaration <- specIds newSpec,-        Just oldDeclaration <- [find ((== idName newDeclaration) . idName) (specIds oldSpec)],-        let oldContract = idDomainContractFor (checkedLanguageContract oldService) (idPrefix oldDeclaration),-        let newContract = idDomainContractFor (checkedLanguageContract newService) (idPrefix newDeclaration),-        oldContract /= newContract-      ]-    contractTypeIdDomainChanges =-      [ breaking-          (ctrName newContract)-          "contract-typeid-domain"-          (ceName newEvent <> "." <> cfName newField)-          ContractTypeIdDomainChanged-          ( renderContractIdDomainChange-              (cfType newField)-              oldContract-              newContract'-          )-      | newContract <- [contract | NContract contract <- specNodes newSpec],-        Just oldContractNode <- [find ((== ctrName newContract) . ctrName) [contract | NContract contract <- specNodes oldSpec]],-        newEvent <- ctrEvents newContract,-        Just oldEvent <- [find ((== ceName newEvent) . ceName) (ctrEvents oldContractNode)],-        newField <- ceFields newEvent,-        Just oldField <- [find ((== cfName newField) . cfName) (ceFields oldEvent)],-        cfType oldField == cfType newField,-        let oldContract = contractFieldIdDomain (checkedLanguageContract oldService) oldField,-        let newContract' = contractFieldIdDomain (checkedLanguageContract newService) newField,-        oldContract /= newContract'-      ]-    semanticContractFoldChange (name, oldAggregate) = case lookup name newAggregates of-      Nothing -> pure []-      Just newAggregate -> do-        oldLegacySurface <- aggregateFoldSurfaceForService (legacyCheckedService oldSpec) oldAggregate-        newLegacySurface <- aggregateFoldSurfaceForService (legacyCheckedService newSpec) newAggregate-        oldSurface <- aggregateFoldSurfaceForService oldService oldAggregate-        newSurface <- aggregateFoldSurfaceForService newService newAggregate-        pure-          [ advisory-              name-              "semantic-contract"-              name-              AggFoldSurfaceChanged-              "effective runtime semantics changed the aggregate fold surface even though the normalized graph is unchanged; re-scaffold, redeploy, and audit replay under the candidate contract"-          | oldLegacySurface == newLegacySurface,-            oldSurface /= newSurface-          ]--renderIdDomainContract :: Maybe IdDomainContract -> Text-renderIdDomainContract Nothing = "legacy-unchecked"-renderIdDomainContract (Just contract) =-  idDomainVersion contract <> "(prefix=" <> idDomainPrefix contract <> ",json=" <> idDomainJsonRepresentation contract <> ")"--contractFieldIdDomain :: EffectiveLanguageContract -> ContractField -> Maybe IdDomainContract-contractFieldIdDomain languageContract field = case cfType field of-  CTypeId prefix -> contractIdDomainContractFor languageContract prefix-  _ -> Nothing--renderContractIdDomainChange :: ContractType -> Maybe IdDomainContract -> Maybe IdDomainContract -> Text-renderContractIdDomainChange fieldType oldContract newContract =-  "contract TypeID admission changed "-    <> renderIdDomainContract oldContract-    <> " -> "-    <> renderIdDomainContract newContract-    <> representationChange-  where-    prefix = case fieldType of-      CTypeId value -> value-      _ -> ""-    representationChange = case (oldContract, newContract) of-      (Nothing, Just _) ->-        "; generated Haskell changes from Text to KindID \""-          <> prefix-          <> "\" while valid JSON stays canonical text; newly generated consumers reject malformed, wrong-prefix, non-canonical, and non-v7 values"-      (Just _, Nothing) ->-        "; generated Haskell changes from KindID \""-          <> prefix-          <> "\" to Text and the generated decoder no longer enforces the frozen TypeID-v7 domain"-      _ -> "; generated contract admission changed while the source field type remained unchanged"--diffCheckedSpecs :: Spec -> Spec -> [Change]-diffCheckedSpecs old new =-  sharedDeclarationDiff env-    ++ concatMap (runFamily env . snd) familyRegistry-  where-    env = DiffEnv old new---- | Compare provenance first, then delegate semantic graphs to 'diffServices'.-diffSources :: ParsedSource -> ParsedSource -> Either FoldSurfaceError [Change]-diffSources old new = do-  semanticChanges <- diffServices (checkedSource old) (checkedSource new)-  pure-    ( sourceLanguageChange-        (specContext (parsedSpec new))-        "declaration"-        (parsedSourceLanguage old)-        (parsedSourceLanguage new)-        <> semanticChanges-    )---- | One all-compatible source-provenance finding, reusable per workspace member.-sourceLanguageChange :: Name -> Text -> SourceLanguage -> SourceLanguage -> [Change]-sourceLanguageChange root subject old new-  | old == new = []-  | otherwise =-      [ mkChange-          LabelAdditive-          (ChangeContext root [] ContextGeneral LabelAdditive)-          root-          "source-language"-          subject-          SourceLanguageDeclarationChanged-          ( "source form changed "-              <> renderSourceLanguage old-              <> " -> "-              <> renderSourceLanguage new-              <> if oldRuntime == newRuntime-                then "; normalized runtime semantics are unchanged"-                else "; effective runtime semantics changed " <> oldRuntime <> " -> " <> newRuntime <> "; see the accompanying semantic-contract findings"-          )-      ]-  where-    oldRuntime = effectiveRuntimeSemantics (effectiveLanguageContract old)-    newRuntime = effectiveRuntimeSemantics (effectiveLanguageContract new)-    renderSourceLanguage sourceLanguage =-      sourceFormText sourceLanguage-        <> maybe "" ((" v" <>) . languageVersionText) (declaredLanguageVersionMaybe sourceLanguage)--runFamily :: DiffEnv -> FamilyDiff -> [Change]-runFamily env (DiffFamily f) = f env-runFamily _ (OutOfDiffScope _) = []---- Rules are outside the decode and persisted-identity axes, but referenced--- rule bodies are compared as part of each aggregate's replay fold surface.-sharedDeclarationDiff :: DiffEnv -> [Change]-sharedDeclarationDiff env = enumDiff env ++ idDiff env ++ nominalScalarDiff env ++ mappedDeclarationDiff env--mappedDeclarationDiff :: DiffEnv -> [Change]-mappedDeclarationDiff env =-  concatMap-    (\finding -> mappedFindingChanges finding <> mappedProjectionFindingChanges env finding)-    (diffMapped (deOld env) (deNew env))---- | A mapped event finding retains its existing private-history change and--- gains one build/review finding per real inline/catalog aggregate consumer.--- Category/all owners never appear because they have no single mapped event--- authority. Operational targets and observers are evidence, not SQL claims.-mappedProjectionFindingChanges :: DiffEnv -> MappedFinding -> [Change]-mappedProjectionFindingChanges env finding = case (projectionImpactFor (deOld env), projectionImpactFor (deNew env)) of-  (Nothing, Nothing) -> []-  (oldImpact, newImpact) ->-    let derivedConsumers =-          maybe Set.empty (`ProjectionImpact.projectionConsumersFor` declarationKey) oldImpact-            <> maybe Set.empty (`ProjectionImpact.projectionConsumersFor` declarationKey) newImpact-     in [ withMappedConsequences (projectionConsequences derived oldOperation newOperation) $-            appendChangeDetail (operationDetail oldOperation newOperation) $-              mappedChange-                (consumerBuildContext root inheritedPaths)-                root-                "mapped-projection"-                subject-                finding-        | derived <- Set.toAscList derivedConsumers,-          let oldOperation = oldImpact >>= operationFor declarationKey derived,-          let newOperation = newImpact >>= operationFor declarationKey derived,-          let inheritedPaths =-                Set.toAscList . Set.fromList $-                  projectionPaths declarationKey derived oldImpact-                    <> projectionPaths declarationKey derived newImpact,-          let root = projectionConsumerRoot derived,-          let subject = mappedConsumerIdentity (DerivedProjectionConsumer derived) <> " inherits " <> unMappedKey declarationKey-        ]-  where-    declarationKey = MappedKey (mfDeclaration finding)-    projectionImpactFor spec = case resolveTypeGraph spec of-      Left _ -> Nothing-      Right graph -> Just (ProjectionImpact.projectionMappedImpact (legacyCheckedService spec) (semanticImpact graph))-    operationFor key derived impact =-      find-        (\(ProjectionImpact.ProjectionOperationalImpact candidate _ _ _ _ _) -> candidate == derived)-        (ProjectionImpact.projectionOperationsFor impact key)-    projectionPaths key derived = maybe [] $ \impact ->-      sort . Set.toList . Set.fromList $-        [ renderUsePath inheritedPath-        | ProjectionImpact.ProjectionMappedRoot candidate declaration inheritedPath <- ProjectionImpact.roots impact,-          candidate == derived,-          declaration == key-        ]-    operationDetail oldOperation newOperation =-      "; derived projection impact: "-        <> renderOperation "previous" oldOperation-        <> "; "-        <> renderOperation "current" newOperation-    renderOperation label Nothing = label <> "=(absent)"-    renderOperation label (Just (ProjectionImpact.ProjectionOperationalImpact _ groupName targetNames observerNames canReplay fingerprint)) =-      label-        <> "=(group="-        <> maybe "(inline)" id groupName-        <> ", targets=["-        <> T.intercalate "," (Set.toAscList targetNames)-        <> "], read-models=["-        <> T.intercalate "," (Set.toAscList observerNames)-        <> "], replayable="-        <> (if canReplay then "yes" else "no")-        <> ", source-fingerprint="-        <> fingerprint-        <> ")"-    appendChangeDetail suffix = \case-      Additive kind -> Additive kind {ckDetail = ckDetail kind <> suffix}-      Advisory kind -> Advisory kind {ckDetail = ckDetail kind <> suffix}-      Breaking kind -> Breaking kind {ckDetail = ckDetail kind <> suffix}-    projectionConsequences derived oldOperation newOperation =-      Set.fromList-        ( [MappedConsumerBuild (DerivedProjectionConsumer derived), MappedProjectionHandlerReview derived]-            <> [ MappedProjectionRebuild derived groupName-               | ProjectionImpact.ProjectionOperationalImpact _ (Just groupName) _ _ True _ <- maybeToList oldOperation <> maybeToList newOperation-               ]-        )-    projectionConsumerRoot (AggregateInlineProjectionConsumer aggregate _) = aggregate-    projectionConsumerRoot (CatalogProjectionConsumer owner _) = owner---- | Explain only declarations for which the authoritative mapped differ emits--- a finding. The compatibility findings remain unchanged; this projection adds--- the checked before/after aggregate consumer sets and service-conformance role.-mappedSemanticImpact :: Spec -> Spec -> [MappedImpactDelta]-mappedSemanticImpact oldSpec newSpec = mappedSemanticImpactForServices (legacyCheckedService oldSpec) (legacyCheckedService newSpec)---- | Service-aware mapped impact adds checked declarative selection consumers;--- the legacy Spec-only entry point retains its historical language contract.-mappedSemanticImpactForServices :: CheckedService -> CheckedService -> [MappedImpactDelta]-mappedSemanticImpactForServices oldService newService = case (resolveTypeGraph oldSpec, resolveTypeGraph newSpec) of-  (Right oldGraph, Right newGraph) ->-    let oldSnapshot = semanticImpactSnapshot (semanticImpactForService oldService oldGraph)-        newSnapshot = semanticImpactSnapshot (semanticImpactForService newService newGraph)-        declarationChanges = [MappedKey (mfDeclaration finding) | finding <- diffMapped oldSpec newSpec]-        relationChanges = map impactDeclaration (diffSemanticImpact oldSnapshot newSnapshot)-     in mappedImpactForDeclarations (declarationChanges <> relationChanges) oldSnapshot newSnapshot-  _ -> []-  where-    oldSpec = checkedSpec oldService-    newSpec = checkedSpec newService--mappedFindingChanges :: MappedFinding -> [Change]-mappedFindingChanges finding-  | mfCode finding == MappedDeclAdded = [mappedDeclarationChange LabelAdditive finding]-  | mfCode finding `elem` [MappedHaskellSourceChanged, MappedRecordConstructorChanged, MappedFixturesChanged, GeneratedHaskellNameChanged] =-      [mappedBuildChange finding]-  | mfCode finding `elem` [MappedInitialChanged, MappedCanonicalTypeChanged] =-      mappedBuildChange finding : map (mappedUseChange finding) registerPaths-  | null paths = [mappedBuildChange finding]-  | otherwise = map (mappedUseChange finding) paths-  where-    paths = mfUsePaths finding-    registerPaths = [path | path@UsePath {upRoot = RootRegister {}} <- paths]--mappedBuildChange :: MappedFinding -> Change-mappedBuildChange finding =-  mappedChange context (mfDeclaration finding) "mapped-build" subject finding-  where-    subject = declarationSubject finding-    renderedPaths = map (\path -> renderMappedSubject path (mfLeaf finding)) (mfUsePaths finding)-    context = (consumerBuildContext (mfDeclaration finding) renderedPaths) {contextOriginalLabel = LabelAdvisory}--mappedDeclarationChange :: Label -> MappedFinding -> Change-mappedDeclarationChange label finding =-  mappedChange context (mfDeclaration finding) "mapped-declaration" (declarationSubject finding) finding-  where-    context = ChangeContext (mfDeclaration finding) [] ContextGeneral label--mappedUseChange :: MappedFinding -> UsePath -> Change-mappedUseChange finding path =-  withMappedConsequences (mappedUseConsequences path) (mappedChange context root facet subject finding)-  where-    subject = renderMappedSubject path (mfLeaf finding)-    (root, facet, kind) = case upRoot path of-      RootCommandField aggregate _ _ _ -> (aggregate, "mapped-command", ContextConsumerBuild)-      RootEventField aggregate _ _ _ -> (aggregate, "mapped-event", ContextPrivateEvent)-      RootRegister aggregate _ _ -> (aggregate, "mapped-register", ContextSnapshot)-      RootWorkqueueField workqueue _ _ -> (workqueue, "mapped-workqueue", ContextQueue)-      RootReadModelQueryInput readModel _ -> (readModel, "mapped-query-input", ContextConsumerBuild)-      RootReadModelQueryResult readModel _ -> (readModel, "mapped-query-result", ContextConsumerBuild)-    context = ChangeContext root [subject] kind (mappedContextHint finding kind)--mappedUseConsequences :: UsePath -> Set MappedConsequence-mappedUseConsequences path = Set.fromList $ case upRoot path of-  RootCommandField aggregate _ _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate)]-  RootEventField aggregate _ _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate), MappedPrivateEventHistory aggregate]-  RootRegister aggregate _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate), MappedSnapshotHydration aggregate]-  RootWorkqueueField workqueue _ _ -> [MappedConsumerBuild (WorkqueueConsumer workqueue), MappedWorkqueueHistory workqueue]-  RootReadModelQueryInput readModel _ -> [MappedConsumerBuild (ReadModelQueryConsumer readModel MappedQueryInput), MappedQueryApi readModel MappedQueryInput]-  RootReadModelQueryResult readModel _ -> [MappedConsumerBuild (ReadModelQueryConsumer readModel MappedQueryResult), MappedQueryApi readModel MappedQueryResult]--withMappedConsequences :: Set MappedConsequence -> Change -> Change-withMappedConsequences consequences = \case-  Additive kind -> Additive kind {ckMappedConsequences = consequences}-  Advisory kind -> Advisory kind {ckMappedConsequences = consequences}-  Breaking kind -> Breaking kind {ckMappedConsequences = consequences}--mappedContextHint :: MappedFinding -> ContextKind -> Label-mappedContextHint finding kind = case kind of-  ContextSnapshot -> LabelAdvisory-  ContextQueue -> LabelBreaking-  ContextConsumerBuild -> LabelAdvisory-  ContextPrivateEvent-    | mfCode finding == MappedFieldAddedWithDefault -> case mfOldUnknownFields finding of-        Just IgnoreUnknown -> LabelAdditive-        _ -> LabelBreaking-    | mfCode finding `elem` [MappedArmAdded, MappedEnumValueAdded] -> LabelAdvisory-    | mfCode finding `elem` [MappedBindingChanged, MappedInitialChanged, MappedCanonicalTypeChanged] -> LabelAdvisory-    | otherwise -> LabelBreaking-  _ -> LabelAdvisory--mappedChange :: ChangeContext -> Name -> Text -> Text -> MappedFinding -> Change-mappedChange context node facet subject finding =-  mkChange label context node facet subject (mfCode finding) detail-  where-    label = deriveLabel defaultGate (classifyCompatibility context (mfCode finding))-    detail = case contextKind context of-      ContextQueue ->-        mfDetail finding-          <> "; queued jobs remain schema-version-1 history; drain the queue or supply an application-owned transitional codec before deployment"-      _ -> mfDetail finding--declarationSubject :: MappedFinding -> Text-declarationSubject finding =-  mfDeclaration finding <> if T.null (mfLeaf finding) then "" else " " <> mfLeaf finding--nodeAggregate :: Node -> Maybe Aggregate-nodeAggregate (NAggregate a) = Just a-nodeAggregate _ = Nothing--nodeProcess :: Node -> Maybe ProcessNode-nodeProcess (NProcess process) = Just process-nodeProcess _ = Nothing--nodeRouter :: Node -> Maybe RouterNode-nodeRouter (NRouter router) = Just router-nodeRouter _ = Nothing--nodeContract :: Node -> Maybe ContractNode-nodeContract (NContract contract) = Just contract-nodeContract _ = Nothing--nodeIntake :: Node -> Maybe IntakeNode-nodeIntake (NIntake intake) = Just intake-nodeIntake _ = Nothing--nodeEmit :: Node -> Maybe EmitNode-nodeEmit (NEmit emit) = Just emit-nodeEmit _ = Nothing--nodePublisher :: Node -> Maybe PublisherNode-nodePublisher (NPublisher publisher) = Just publisher-nodePublisher _ = Nothing--nodeWorkqueue :: Node -> Maybe WorkqueueNode-nodeWorkqueue (NWorkqueue workqueue) = Just workqueue-nodeWorkqueue _ = Nothing--nodePgmqDispatch :: Node -> Maybe PgmqDispatchNode-nodePgmqDispatch (NPgmqDispatch dispatch) = Just dispatch-nodePgmqDispatch _ = Nothing--nodeReadModel :: Node -> Maybe ReadModelNode-nodeReadModel (NReadModel readModel) = Just readModel-nodeReadModel _ = Nothing--nodeProjectionTarget :: Node -> Maybe ProjectionTargetNode-nodeProjectionTarget (NProjectionTarget target) = Just target-nodeProjectionTarget _ = Nothing--nodeRebuildGroup :: Node -> Maybe RebuildGroupNode-nodeRebuildGroup (NRebuildGroup groupNode) = Just groupNode-nodeRebuildGroup _ = Nothing--nodeProjectionRevision :: Node -> Maybe ProjectionRevisionNode-nodeProjectionRevision (NProjectionRevision revision) = Just revision-nodeProjectionRevision _ = Nothing--nodeExternalRead :: Node -> Maybe ExternalReadNode-nodeExternalRead (NExternalRead externalRead) = Just externalRead-nodeExternalRead _ = Nothing--nodeProjectionOwner :: Node -> Maybe ProjectionOwnerNode-nodeProjectionOwner (NProjectionOwner owner) = Just owner-nodeProjectionOwner _ = Nothing--nodeWorkflow :: Node -> Maybe WorkflowNode-nodeWorkflow (NWorkflow workflow) = Just workflow-nodeWorkflow _ = Nothing---- | Router identity is replay-sensitive: the stable name and key feed every--- target-keyed dispatch id, and the target selects the persisted stream family.-routerDiff :: DiffEnv -> [Change]-routerDiff env =-  concatMap (uncurry routerPairDiff) (prMatched paired)-    ++ [additive (rtId router) "router" (rtId router) DeclarationAdded "new router declaration" | router <- prAdded paired]-    ++ [breaking (rtId router) "router-identity" (rtId router) RouterStableNameChanged "router removed while replayable source events may still derive target-keyed dispatch ids from its stable identity" | router <- prRemoved paired]-  where-    paired = pairByName nodeRouter rtId env--routerPairDiff :: RouterNode -> RouterNode -> [Change]-routerPairDiff oldRouter newRouter =-  stableName-    ++ keyDerivation-    ++ target-    ++ routerDecideSurfaceDiff oldRouter newRouter-  where-    nodeName = rtId newRouter-    stableName =-      [ breaking nodeName "router-stable-name" nodeName RouterStableNameChanged $-          "router stable name changed from '" <> rtName oldRouter <> "' to '" <> rtName newRouter <> "'; every deterministicRouterCommandId is re-keyed, so redelivery can duplicate the full resolved fan-out"-      | rtName oldRouter /= rtName newRouter-      ]-    keyDerivation =-      [ breaking nodeName "router-key" (corrField (rtKey newRouter)) DerivedIdentityChanged "router key field or derivation changed; replay derives different target dispatch ids"-      | rtKey oldRouter /= rtKey newRouter-      ]-    target =-      [ breaking nodeName "router-target" (rtTarget newRouter) DerivedIdentityChanged "router target aggregate changed; replay addresses a different persisted stream family"-      | rtTarget oldRouter /= rtTarget newRouter-      ]--routerDecideSurfaceDiff :: RouterNode -> RouterNode -> [Change]-routerDecideSurfaceDiff oldRouter newRouter =-  [ advisory-      (rtId newRouter)-      "router-decide"-      (rtId newRouter)-      RouterDecideSurfaceChanged-      "router dispatch surface changed: a source event redelivered across the deploy dispatches under the same deterministic ids, so half-old/half-new fan-out merges silently. Drain or pause the router's subscription and replay or discard dead letters before deploying; see docs/user/deploy-ordering.md. Hole-only decide changes are not visible to diff; the same drain rule applies to those too."-  | oldSurface /= newSurface-  ]-  where-    oldSurface =-      ( renderResolveSurface (rtResolve oldRouter),-        renderRouterDispatchSurface (rtDispatch oldRouter)-      )-    newSurface =-      ( renderResolveSurface (rtResolve newRouter),-        renderRouterDispatchSurface (rtDispatch newRouter)-      )--readModelDiff :: DiffEnv -> [Change]-readModelDiff env =-  concatMap (uncurry (readModelPairDiff env oldSupplies newSupplies)) (prMatched paired)-    ++ concatMap addedReadModelDiff (prAdded paired)-    ++ concatMap removedReadModelDiff (prRemoved paired)-  where-    paired = pairByName nodeReadModel rmName env-    oldSupplies = analyzeProjectionSupplies (deOld env)-    newSupplies = analyzeProjectionSupplies (deNew env)--readModelPairDiff :: DiffEnv -> ProjectionSupplyAnalysis -> ProjectionSupplyAnalysis -> ReadModelNode -> ReadModelNode -> [Change]-readModelPairDiff env oldSupplies newSupplies oldReadModel newReadModel =-  versionChanges-    ++ shapeChanges-    ++ identityChanges-    ++ policyChanges-    ++ bindingChanges-    ++ queryContractChanges-  where-    nodeName = rmName newReadModel-    versionChanges-      | rmVersion newReadModel < rmVersion oldReadModel =-          [ breaking nodeName "read-model-version" nodeName ReadModelVersionDecreased ("version decreased from " <> tInt (rmVersion oldReadModel) <> " to " <> tInt (rmVersion newReadModel))-          ]-      | rmVersion newReadModel > rmVersion oldReadModel =-          [ additive nodeName "read-model-version" nodeName VersionBumped ("version increased from " <> tInt (rmVersion oldReadModel) <> " to " <> tInt (rmVersion newReadModel) <> "; register and rebuild the new shape before serving it")-          ]-      | otherwise = []-    oldShape = (rmColumns oldReadModel, rmShape oldReadModel)-    newShape = (rmColumns newReadModel, rmShape newReadModel)-    shapeChanges =-      [ breaking nodeName "read-model-shape" nodeName ReadModelShapeChangedWithoutBump ("declared columns or captured shape hash changed at version " <> tInt (rmVersion newReadModel) <> "; bump version and rebuild")-      | oldShape /= newShape,-        rmVersion oldReadModel == rmVersion newReadModel-      ]-    oldRegistry = registryNameFor (specContext (deOld env)) oldReadModel-    newRegistry = registryNameFor (specContext (deNew env)) newReadModel-    oldSubscription = subscriptionNameFor (specContext (deOld env)) oldReadModel-    newSubscription = subscriptionNameFor (specContext (deNew env)) newReadModel-    identityChanges =-      [ breaking nodeName "read-model-identity" nodeName DerivedIdentityChanged ("registry name changed '" <> oldRegistry <> "' -> '" <> newRegistry <> "'; the old registration row is orphaned")-      | oldRegistry /= newRegistry-      ]-        ++ [ breaking nodeName "read-model-table" nodeName DerivedIdentityChanged ("qualified table changed '" <> qualifiedIdentity oldReadModel <> "' -> '" <> qualifiedIdentity newReadModel <> "'; existing data remains under the old identity")-           | (rmSchema oldReadModel, rmTable oldReadModel) /= (rmSchema newReadModel, rmTable newReadModel)-           ]-        ++ [ breaking nodeName "read-model-subscription" nodeName DerivedIdentityChanged ("subscription changed '" <> oldSubscription <> "' -> '" <> newSubscription <> "'; the worker cursor remains under the old identity")-           | oldSubscription /= newSubscription-           ]-    -- There are three policy comparison shapes: catalog-owned on both sides,-    -- legacy on both sides, or a migration between them. The mixed case uses-    -- the normalized freshness matrix in docs/plans/250-report-legacy-strong-consistency-weakening-across-the-language-4-to-5-migration-in-diff.md;-    -- unlike two catalog-owned revisions, a migration strengthening is additive.-    policyChanges = case (rmSupply oldReadModel, rmSupply newReadModel) of-      (OwnerDerivedSupply, OwnerDerivedSupply) ->-        [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness changed " <> renderFreshness (rmFreshness oldReadModel) <> " -> " <> renderFreshness (rmFreshness newReadModel) <> "; catalog and owning-group query policy identity changed")-        | rmFreshness oldReadModel /= rmFreshness newReadModel-        ]-      (LegacyReadModelSupply {}, LegacyReadModelSupply {}) ->-        legacyFeedChanges <> legacyConsistencyChanges <> legacyScopeChanges-      _ -> migrationFreshnessChanges-    migrationFreshnessChanges = case (rmFreshness oldReadModel, rmFreshness newReadModel) of-      (oldFreshness, newFreshness)-        | oldFreshness == newFreshness -> []-      (FreshnessWaitForHead _, FreshnessImmediate) ->-        [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness weakened " <> renderFreshness (rmFreshness oldReadModel) <> " -> immediate across the legacy consistency migration; callers lose the cursor-wait guarantee")-        ]-      (FreshnessImmediate, FreshnessWaitForHead _) ->-        [ additive nodeName "query-freshness" nodeName CompatibilityStrengthened ("query freshness strengthened immediate -> " <> renderFreshness (rmFreshness newReadModel) <> " across the legacy consistency migration; callers gain a cursor-wait guarantee")-        ]-      (FreshnessWaitForHead oldWaitScope, FreshnessWaitForHead newWaitScope)-        | scopeStrengthened oldWaitScope newWaitScope ->-            [ additive nodeName "query-freshness" nodeName CompatibilityStrengthened ("query freshness head scope widened " <> renderScope oldWaitScope <> " -> " <> renderScope newWaitScope <> " across the legacy consistency migration")-            ]-        | otherwise ->-            [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness head scope changed " <> renderScope oldWaitScope <> " -> " <> renderScope newWaitScope <> " across the legacy consistency migration; callers no longer wait on the same event surface")-            ]-      (FreshnessImmediate, FreshnessImmediate) -> []-    legacyFeedChanges =-      [ breaking nodeName "read-model-feed" nodeName ReadModelFeedChanged ("feed changed " <> renderFeed oldFeed <> " -> " <> renderFeed newFeed <> "; projection wiring and rebuild identities changed")-      | Just oldFeed <- [legacyReadModelFeed oldReadModel],-        Just newFeed <- [legacyReadModelFeed newReadModel],-        oldFeed /= newFeed-      ]-    legacyConsistencyChanges = case (legacyReadModelConsistency oldReadModel, legacyReadModelConsistency newReadModel) of-      (Just Strong, Just Eventual) ->-        [breaking nodeName "read-model-consistency" nodeName ReadModelConsistencyWeakened "default consistency changed Strong -> Eventual; callers lose the cursor-wait guarantee"]-      (Just Eventual, Just Strong) ->-        [additive nodeName "read-model-consistency" nodeName CompatibilityStrengthened "default consistency changed Eventual -> Strong; callers gain a cursor-wait guarantee"]-      _ -> []-    oldScope = effectiveScope (legacyReadModelScope oldReadModel)-    newScope = effectiveScope (legacyReadModelScope newReadModel)-    legacyScopeChanges-      | oldScope == newScope = []-      | scopeStrengthened oldScope newScope =-          [additive nodeName "read-model-scope" nodeName CompatibilityStrengthened ("Strong scope widened " <> renderScope oldScope <> " -> " <> renderScope newScope)]-      | otherwise =-          [breaking nodeName "read-model-scope" nodeName ReadModelConsistencyWeakened ("Strong scope changed " <> renderScope oldScope <> " -> " <> renderScope newScope <> "; callers no longer wait on the same event surface")]-    bindingChanges =-      [ breaking nodeName "read-model-catalog-binding" nodeName CatalogQueryBindingChanged "query-model rebuild group, observed target set, resolved projection supplier, or backing target changed; persisted lifecycle identity and rebuild completeness changed"-      | bindingIdentity oldSupplies oldReadModel /= bindingIdentity newSupplies newReadModel-      ]-    bindingIdentity supplyAnalysis readModel =-      ( rmGroup readModel,-        Set.fromList (rmObservedTargets readModel),-        resolvedSupplier supplyAnalysis readModel,-        effectiveBacking readModel-      )-    resolvedSupplier supplyAnalysis readModel =-      case [ supplyProjectionOwner supply-           | supply <- resolvedProjectionSupplies supplyAnalysis,-             supplyQueryModel supply == rmName readModel-           ] of-        [ownerName] -> Just ownerName-        _ -> Nothing-    effectiveBacking readModel = case rmBackingTarget readModel of-      Just target -> Just target-      Nothing -> case rmObservedTargets readModel of-        [single] -> Just single-        _ -> Nothing-    queryContractChanges =-      queryPositionChange-        "input"-        MappedQueryInput-        ReadModelQueryInputChanged-        (input <$> queryTypes oldReadModel)-        (input <$> queryTypes newReadModel)-        "callers"-        <> queryPositionChange-          "result"-          MappedQueryResult-          ReadModelQueryResultChanged-          (result <$> queryTypes oldReadModel)-          (result <$> queryTypes newReadModel)-          "result consumers"-    queryPositionChange position mappedPosition code oldExpression newExpression owner =-      [ withMappedConsequences-          (Set.fromList [MappedConsumerBuild consumer, MappedQueryApi nodeName mappedPosition])-          ( advisoryAt-              (consumerBuildContext nodeName [nodeName <> " query " <> position])-              nodeName-              ("read-model-query-" <> position)-              (nodeName <> " query " <> position)-              code-              ( "query "-                  <> position-                  <> " changed "-                  <> renderMaybeType oldExpression-                  <> " -> "-                  <> renderMaybeType newExpression-                  <> "; recompile "-                  <> owner-                  <> " against the generated QueryContract. SQL columns, projection replay, and persisted history are unaffected"-              )-          )-      | oldExpression /= newExpression-      ]-      where-        consumer = ReadModelQueryConsumer nodeName mappedPosition-    renderMaybeType = maybe "(absent)" renderTypeExpr--projectionTargetDiff :: DiffEnv -> [Change]-projectionTargetDiff env =-  concatMap (uncurry projectionTargetPairDiff) (prMatched paired)-    <> [additive (ptName target) "projection-target" (ptName target) CatalogTargetAdded "new application-owned target; consumer DDL is still required" | target <- prAdded paired]-    <> [breaking (ptName target) "projection-target" (ptName target) CatalogTargetRemoved "target declaration removed while table data and rebuild evidence may remain" | target <- prRemoved paired]-  where-    paired = pairByName nodeProjectionTarget ptName env--projectionTargetPairDiff :: ProjectionTargetNode -> ProjectionTargetNode -> [Change]-projectionTargetPairDiff oldTarget newTarget = locationChange <> resetChange <> dependencyChange-  where-    targetName = ptName newTarget-    locationChange =-      [ breaking targetName "projection-target-location" targetName CatalogTargetLocationChanged $-          "qualified target changed " <> ptSchema oldTarget <> "." <> ptTable oldTarget <> " -> " <> ptSchema newTarget <> "." <> ptTable newTarget <> "; Keiro does not move application data"-      | (ptSchema oldTarget, ptTable oldTarget) /= (ptSchema newTarget, ptTable newTarget)-      ]-    resetChange = case (ptReset oldTarget, ptReset newTarget) of-      (TargetPreserve, TargetClear) -> [breaking targetName "projection-target-reset" targetName CatalogTargetResetPolicyChanged "reset changed preserve -> clear; a rebuild can now delete retained brownfield data"]-      (TargetClear, TargetPreserve) -> [advisory targetName "projection-target-reset" targetName CatalogTargetResetPolicyChanged "reset changed clear -> preserve; application reconciliation must now prove retained rows"]-      _ -> []-    dependencyChange =-      [ breaking targetName "projection-target-dependencies" targetName CatalogTargetDependencyChanged "target dependency order changed; abandon any active fingerprint and start a fresh group rebuild"-      | ptDependsOn oldTarget /= ptDependsOn newTarget-      ]--rebuildGroupDiff :: DiffEnv -> [Change]-rebuildGroupDiff env =-  concatMap (uncurry rebuildGroupPairDiff) (prMatched paired)-    <> [additive (rgName groupNode) "rebuild-group" (rgName groupNode) DeclarationAdded "new rebuild group" | groupNode <- prAdded paired]-    <> [breaking (rgName groupNode) "rebuild-group" (rgName groupNode) CatalogGroupChanged "rebuild group removed while lifecycle and run evidence may remain" | groupNode <- prRemoved paired]-  where-    paired = pairByName nodeRebuildGroup rgName env--rebuildGroupPairDiff :: RebuildGroupNode -> RebuildGroupNode -> [Change]-rebuildGroupPairDiff oldGroup newGroup =-  [ breaking (rgName newGroup) "rebuild-group-membership-order" (rgName newGroup) CatalogGroupChanged "target membership or deterministic preparation order changed; abandon any active fingerprint and start a fresh rebuild"-  | (rgTargets oldGroup, rgOrder oldGroup) /= (rgTargets newGroup, rgOrder newGroup)-  ]--projectionRevisionDiff :: DiffEnv -> [Change]-projectionRevisionDiff env =-  concatMap (uncurry projectionRevisionPairDiff) (prMatched paired)-    <> [additive (prvName revision) "projection-revision" (prvName revision) DeclarationAdded "new projection revision and target-schema contract" | revision <- prAdded paired]-    <> [breaking (prvName revision) "projection-revision" (prvName revision) CatalogProjectionRevisionRemoved "projection revision removed while serving, rebuild, or read-contract evidence may still refer to it" | revision <- prRemoved paired]-  where-    paired = pairByName nodeProjectionRevision prvName env--projectionRevisionPairDiff :: ProjectionRevisionNode -> ProjectionRevisionNode -> [Change]-projectionRevisionPairDiff oldRevision newRevision = groupChange <> schemaChanges <> contractChanges-  where-    revisionName = prvName newRevision-    oldTargets = Map.fromList [(prtTarget target, target) | target <- prvTargets oldRevision]-    newTargets = Map.fromList [(prtTarget target, target) | target <- prvTargets newRevision]-    groupChange =-      [ breaking revisionName "projection-revision-group" revisionName CatalogProjectionRevisionChanged "revision rebuild group changed; persisted revision and generation identity no longer matches"-      | prvGroup oldRevision /= prvGroup newRevision-      ]-    schemaChanges =-      [ breaking revisionName "target-schema" targetName CatalogTargetSchemaChanged $-          "target schema version changed " <> prtSchemaVersion oldTarget <> " -> " <> prtSchemaVersion newTarget <> "; declare a new projection revision instead of mutating a registered one"-      | (targetName, oldTarget) <- Map.toAscList oldTargets,-        Just newTarget <- [Map.lookup targetName newTargets],-        prtSchemaVersion oldTarget /= prtSchemaVersion newTarget-      ]-    contractChanges =-      [ breaking revisionName "projection-revision-contract" revisionName CatalogProjectionRevisionChanged "target membership, provisioner, expected-shape, validator, or ordered promotion-name contract changed; declare a new revision identity"-      | Map.keysSet oldTargets /= Map.keysSet newTargets-          || any targetContractChanged (Map.toAscList oldTargets)-      ]-    targetContractChanged (targetName, oldTarget) = case Map.lookup targetName newTargets of-      Nothing -> True-      Just newTarget ->-        ( prtProvisioner oldTarget,-          prtProvisionerVersion oldTarget,-          prtExpectedShape oldTarget,-          prtValidator oldTarget,-          prtValidatorVersion oldTarget,-          prtPromotionObjects oldTarget-        )-          /= ( prtProvisioner newTarget,-               prtProvisionerVersion newTarget,-               prtExpectedShape newTarget,-               prtValidator newTarget,-               prtValidatorVersion newTarget,-               prtPromotionObjects newTarget-             )--externalReadDiff :: DiffEnv -> [Change]-externalReadDiff env =-  concatMap (uncurry (externalReadPairDiff env)) (prMatched paired)-    <> [ additive-           (externalReadNodeIdentity externalRead)-           "external-read-version"-           (erName externalRead)-           CatalogExternalReadVersionAdded-           "new external read-contract version; grant execute only after its result type and wrapper are deployed"-       | externalRead <- prAdded paired-       ]-    <> [ breaking-           (externalReadNodeIdentity externalRead)-           "external-read-retirement"-           (erName externalRead)-           CatalogExternalReadRetired-           "external read-contract version removed; preview dependencies and retire it explicitly before removing the declaration"-       | externalRead <- prRemoved paired-       ]-  where-    paired = pairByName nodeExternalRead externalReadNodeIdentity env--externalReadPairDiff :: DiffEnv -> ExternalReadNode -> ExternalReadNode -> [Change]-externalReadPairDiff env oldExternalRead newExternalRead =-  immutableChanges <> compatibilityChanges <> shapeChanges <> generationChanges-  where-    subject = externalReadNodeIdentity newExternalRead-    immutableChanges =-      [ breaking subject "external-read-contract" (erName newExternalRead) CatalogExternalReadContractChanged "query binding or public result type changed for an existing contract version; publish a new version"-      | ( erQueryModel oldExternalRead,-          erResultSchema oldExternalRead,-          erResultType oldExternalRead-        )-          /= ( erQueryModel newExternalRead,-               erResultSchema newExternalRead,-               erResultType newExternalRead-             )-      ]-    oldCompatibility = Set.fromList (erCompatibleRevisions oldExternalRead)-    newCompatibility = Set.fromList (erCompatibleRevisions newExternalRead)-    compatibilityChanges-      | oldCompatibility == newCompatibility = []-      | oldCompatibility `Set.isSubsetOf` newCompatibility =-          [ additive subject "external-read-compatibility" (erName newExternalRead) CatalogExternalReadCompatibilityChanged "compatible projection-revision set widened; deploy the higher surface generation before promoting the added revision"-          ]-      | otherwise =-          [ breaking subject "external-read-compatibility" (erName newExternalRead) CatalogExternalReadCompatibilityChanged "compatible projection-revision set narrowed or replaced for an existing contract version"-          ]-    shapeChanges =-      [ breaking subject "external-read-result-shape" (erName newExternalRead) CatalogExternalReadResultShapeChanged "checked query result shape changed for an existing contract version; restore compatibility or publish a new version"-      | externalReadShape (deOld env) oldExternalRead /= externalReadShape (deNew env) newExternalRead-      ]-    generationChanges-      | erSurfaceGeneration oldExternalRead == erSurfaceGeneration newExternalRead = []-      | erSurfaceGeneration oldExternalRead < erSurfaceGeneration newExternalRead =-          [ advisory subject "external-read-surface-generation" (erName newExternalRead) CatalogExternalReadContractChanged "surface generation increased; roll out the newer declaration before older processes can reconcile"-          ]-      | otherwise =-          [ breaking subject "external-read-surface-generation" (erName newExternalRead) CatalogExternalReadContractChanged "surface generation decreased; runtime reconciliation refuses this downgrade"-          ]-    externalReadShape spec externalRead = case [rmShape readModel | NReadModel readModel <- specNodes spec, rmName readModel == erQueryModel externalRead] of-      shape : _ -> Just shape-      [] -> Nothing--projectionOwnerDiff :: DiffEnv -> [Change]-projectionOwnerDiff env =-  concatMap (uncurry projectionOwnerPairDiff) (prMatched paired)-    <> [additive (poName owner) "projection-owner" (poName owner) DeclarationAdded "new projection owner" | owner <- prAdded paired]-    <> [breaking (poName owner) "projection-owner" (poName owner) CatalogOwnerRemoved "projection owner removed while targets and replay evidence remain" | owner <- prRemoved paired]-  where-    paired = pairByName nodeProjectionOwner poName env--projectionOwnerPairDiff :: ProjectionOwnerNode -> ProjectionOwnerNode -> [Change]-projectionOwnerPairDiff oldOwner newOwner = groupAndTargets <> orderChange <> sourceChange <> feedIdentityChange <> checkpointPolicyChange <> replayChange-  where-    ownerName = poName newOwner-    groupAndTargets =-      [ breaking ownerName "projection-owner-group-targets" ownerName CatalogOwnerChanged "rebuild group or owned target set changed"-      | (poGroup oldOwner, Set.fromList (poTargets oldOwner)) /= (poGroup newOwner, Set.fromList (poTargets newOwner))-      ]-    orderChange =-      [ advisory ownerName "projection-owner-order" ownerName CatalogHandlerOrderChanged "handler order changed; replay materialization and resume fingerprint change"-      | poOrder oldOwner /= poOrder newOwner-      ]-    sourceChange =-      [ breaking ownerName "projection-owner-sources" ownerName CatalogSourceChanged "source selection changed; historical coverage and active resume fingerprint change"-      | poSources oldOwner /= poSources newOwner-      ]-    feedIdentityChange =-      [ breaking ownerName "projection-delivery" ownerName ProjectionDeliveryChanged "projection delivery changed; handler lifecycle, cursor, and dedup identity require coordinated review"-      | poDelivery oldOwner /= poDelivery newOwner-      ]-        <> [ breaking ownerName "projection-owner-delivery-identity" ownerName CatalogFeedIdentityChanged "subscription or dedup identity changed; cursors or dedup evidence remain under the old identity"-           | (poSubscription oldOwner, poDedup oldOwner) /= (poSubscription newOwner, poDedup newOwner)-           ]-    checkpointPolicyChange =-      [ breaking ownerName "projection-owner-checkpoint-on-missing" ownerName CatalogCheckpointPolicyChanged $-          "checkpoint-on-missing changed " <> renderCheckpointOnMissing oldPolicy <> " -> " <> renderCheckpointOnMissing newPolicy <> "; the generated catalog and next absent-row startup behavior change, while persisted subscription identity and existing checkpoint rows remain unchanged"-      | [oldPolicy] <- [poCheckpointOnMissing oldOwner],-        [newPolicy] <- [poCheckpointOnMissing newOwner],-        oldPolicy /= newPolicy-      ]-    replayChange =-      [ breaking ownerName "projection-owner-replay-policy" ownerName CatalogReplayPolicyChanged "replay policy changed; abandon any active run before rebuilding under the new contract"-      | poReplay oldOwner /= poReplay newOwner-      ]--renderCheckpointOnMissing :: CheckpointOnMissingNode -> Text-renderCheckpointOnMissing CheckpointFromBeginning = "from-beginning"-renderCheckpointOnMissing CheckpointFromCurrentHead = "from-current-head"-renderCheckpointOnMissing CheckpointFail = "fail"--addedReadModelDiff :: ReadModelNode -> [Change]-addedReadModelDiff readModel =-  [additive (rmName readModel) "read-model" (rmName readModel) DeclarationAdded "new read model"]--removedReadModelDiff :: ReadModelNode -> [Change]-removedReadModelDiff readModel =-  [breaking (rmName readModel) "read-model-identity" (rmName readModel) DerivedIdentityChanged "read model removed while registered metadata, data, subscription cursors, and callers may remain"]--qualifiedIdentity :: ReadModelNode -> Text-qualifiedIdentity readModel = rmSchema readModel <> "." <> rmTable readModel--renderFeed :: RmFeed -> Text-renderFeed RmInline = "inline"-renderFeed RmSubscription = "subscription"--renderFreshness :: QueryFreshnessNode -> Text-renderFreshness FreshnessImmediate = "immediate"-renderFreshness (FreshnessWaitForHead scope) = "wait-for-head " <> renderScope scope--effectiveScope :: Maybe RmScope -> RmScope-effectiveScope Nothing = RmEntireLog-effectiveScope (Just scope) = scope--scopeStrengthened :: RmScope -> RmScope -> Bool-scopeStrengthened (RmCategory _) RmEntireLog = True-scopeStrengthened _ _ = False--renderScope :: RmScope -> Text-renderScope RmEntireLog = "entire-log"-renderScope (RmCategory categoryName) = "category '" <> categoryName <> "'"--aggregateDiff :: DiffEnv -> [Change]-aggregateDiff env =-  concatMap-    (\(oldAggregate, newAggregate) -> aggregatePairDiff (deOld env) (deNew env) oldAggregate newAggregate)-    (prMatched paired)-    ++ concatMap addedAggregateDiff (prAdded paired)-    ++ concatMap removedAggregateDiff (prRemoved paired)-  where-    paired = pairByName nodeAggregate aggName env--aggregatePairDiff :: Spec -> Spec -> Aggregate -> Aggregate -> [Change]-aggregatePairDiff oldSpec newSpec oldAgg newAgg =-  commandFieldIdentityDiff oldAgg newAgg-    ++ concatMap (eventDiff oldAgg newAgg) (aggEvents newAgg)-    ++ removedEvents oldAgg newAgg-    ++ wireDiff oldAgg newAgg-    ++ projectionDiff oldAgg newAgg-    ++ guardTighteningDiff oldAgg newAgg-    ++ domainOutcomeDiff oldAgg newAgg-    ++ transitionSurfaceDiff oldSpec newSpec oldAgg newAgg---- | Typed outcomes are forward command behavior, not persisted fold behavior.--- Pair transitions by their frozen fold canonical form so a reason-only change--- reports precisely without also claiming replay or snapshot impact.-domainOutcomeDiff :: Aggregate -> Aggregate -> [Change]-domainOutcomeDiff oldAggregate newAggregate = declarationChange ++ transitionChanges-  where-    declarationChange =-      [ advisory-          (aggName newAggregate)-          "domain-outcome-types"-          (aggName newAggregate)-          DomainOutcomeTypesChanged-          ( "domain outcome types changed from '"-              <> renderDeclaration (aggDomainOutcomeTypes oldAggregate)-              <> "' to '"-              <> renderDeclaration (aggDomainOutcomeTypes newAggregate)-              <> "'; generated command result types and callers must be updated, while event history and snapshots remain compatible"-          )-      | canonicalDomainOutcomeTypes (aggDomainOutcomeTypes oldAggregate)-          /= canonicalDomainOutcomeTypes (aggDomainOutcomeTypes newAggregate)-      ]-    transitionChanges =-      [ advisory-          (aggName newAggregate)-          "transition-domain-outcome"-          (transitionSubject ordinal newTransition)-          DomainTransitionOutcomeChanged-          ( "domain outcome changed from '"-              <> canonicalTransitionOutcome (tOutcome oldTransition)-              <> "' to '"-              <> canonicalTransitionOutcome (tOutcome newTransition)-              <> "'; forward command behavior changes, while the selected edge, emitted events, fold, replay, and snapshots remain unchanged"-          )-      | (ordinal, newTransition) <- zip [0 :: Int ..] (aggTransitions newAggregate),-        Just oldTransition <- [find ((== canonicalTransition newTransition) . canonicalTransition) (aggTransitions oldAggregate)],-        canonicalTransitionOutcome (tOutcome oldTransition) /= canonicalTransitionOutcome (tOutcome newTransition)-      ]-    renderDeclaration declaration = case canonicalDomainOutcomeTypes declaration of-      "" -> "(disabled)"-      value -> value-    transitionSubject ordinal transition =-      tSource transition <> " -- " <> tCommand transition <> " [edge " <> T.pack (show ordinal) <> "]"---- | Report replay-fold evolution. Regenerated scaffold code carries the new--- fingerprint and invalidates old snapshots, so this remains advisory.-transitionSurfaceDiff :: Spec -> Spec -> Aggregate -> Aggregate -> [Change]-transitionSurfaceDiff oldSpec newSpec oldAgg newAgg-  | aggregateFoldSurfaceForService (legacyCheckedService oldSpec) oldAgg == aggregateFoldSurfaceForService (legacyCheckedService newSpec) newAgg = []-  | otherwise =-      [ advisory-          (aggName newAgg)-          "transitions"-          (aggName newAgg)-          AggFoldSurfaceChanged-          "aggregate fold surface changed: replay now interprets the existing log under the new fold. Old snapshots are invalidated automatically once the regenerated fold fingerprint deploys; if the change is fold-neutral confirm it, otherwise re-scaffold and redeploy, and bump `state-codec version=` for any accompanying Holes-only change."-      ]---- | Plan 143: guard changes are replay-relevant. Hydration re-inverts each--- stored event and re-checks the edge guard, so a stored event legally appended--- under the old guard may no longer satisfy the new one — the next command on--- any stream containing such an event fails hydration with no inverting edge.--- The remedy is mechanical, so the tool computes it: the removed region is--- @old-guard ∧ ¬new-guard@ ('complementExpr' eliminates the negation inside the--- existing grammar), and the advisory prints a paste-ready replay-only twin--- carrying that region with the OLD transition's writes\/emits\/goto. Whether--- history should stay replayable (paste the twin) or be truncated instead is a--- business decision, so the twin is never auto-applied.------ Detection is conservative: any guard change on a paired live (source,--- command) transition where the new spec declares a guard and does not already--- contain a replay-only twin for the pair. A pure loosening also matches; the--- advisory says how to confirm no stored data is affected (the replay audit,--- docs/plans/142) rather than guessing.-guardTighteningDiff :: Aggregate -> Aggregate -> [Change]-guardTighteningDiff oldAgg newAgg =-  [ advisory (aggName newAgg) "transition" subject AggGuardTightened detail-  | newT <- aggTransitions newAgg,-    tMode newT == TmLive,-    Just oldT <--      [ find-          (\o -> tSource o == tSource newT && tCommand o == tCommand newT && tMode o == TmLive)-          (aggTransitions oldAgg)-      ],-    tGuard newT /= tGuard oldT,-    Just newGuard <- [tGuard newT],-    not (hasReplayOnlyTwin newT),-    let subject = tSource newT <> " -- " <> tCommand newT,-    let removedRegion =-          maybe (complementExpr newGuard) (\o -> EAnd o (complementExpr newGuard)) (tGuard oldT),-    let twin = oldT {tGuard = Just removedRegion, tMode = TmReplayOnly},-    let detail =-          "guard changed on "-            <> subject-            <> ". Stored events appended under the old guard may no longer invert: "-            <> "the next command on any stream containing one fails hydration with "-            <> "no inverting edge. Either confirm via the replay audit that no stored "-            <> "stream exercises the removed region, or keep history replayable by "-            <> "adding the computed replay-only twin (the removed region with the old "-            <> "transition's writes/emits/goto):\n\n"-            <> renderTransition twin-  ]-  where-    hasReplayOnlyTwin newT =-      any-        (\t -> tMode t == TmReplayOnly && tSource t == tSource newT && tCommand t == tCommand newT)-        (aggTransitions newAgg)--addedAggregateDiff :: Aggregate -> [Change]-addedAggregateDiff newAgg =-  [ additive (aggName newAgg) "event" (evName e) DeclarationAdded "new event type (new aggregate)"-  | e <- aggEvents newAgg-  ]--removedAggregateDiff :: Aggregate -> [Change]-removedAggregateDiff oldAgg =-  [ breaking (aggName oldAgg) "event" (evName e) EvtRemovedNotDeprecated "aggregate removed; its event tags are no longer decodable"-  | e <- aggEvents oldAgg-  ]---- | Per-event classification for an event present in the new aggregate.-eventDiff :: Aggregate -> Aggregate -> Event -> [Change]-eventDiff oldAgg newAgg e =-  case find ((== evName e) . evName) (aggEvents oldAgg) of-    Nothing ->-      [additive (aggName newAgg) "event" (evName e) DeclarationAdded "new event type"]-    Just oldE-      | evVersion e > evVersion oldE ->-          selectorChanges oldE-            ++ if evVersion e == evVersion oldE + 1 && evUpcastFrom e `hasSource` evVersion oldE-              then-                [additive (aggName newAgg) "event" (evName e) VersionBumped ("new version v" <> tInt (evVersion e) <> " with upcaster from v" <> tInt (evVersion oldE))]-                  ++ [ breaking-                         (aggName newAgg)-                         "event"-                         (evName e)-                         UpcasterChainGap-                         ( "bumping v"-                             <> tInt (evVersion oldE)-                             <> " to v"-                             <> tInt (evVersion e)-                             <> " replaced the 'upcast from v"-                             <> tInt vanishedSource-                             <> "' rung; stored v"-                             <> tInt vanishedSource-                             <> " payloads can no longer decode"-                         )-                     | Just (vanishedSource, _) <- [evUpcastFrom oldE],-                       not (aggregateHasUpcasterSource newAgg vanishedSource)-                     ]-              else-                [ breaking-                    (aggName newAgg)-                    "event"-                    (evName e)-                    EvtVersionMissingUpcaster-                    ( "version changed from v"-                        <> tInt (evVersion oldE)-                        <> " to v"-                        <> tInt (evVersion e)-                        <> " without the required contiguous upcaster from v"-                        <> tInt (evVersion oldE)-                    )-                ]-      | evVersion e < evVersion oldE ->-          selectorChanges oldE-            ++ [breaking (aggName newAgg) "event" (evName e) EvtVersionDecreased ("version decreased from v" <> tInt (evVersion oldE) <> " to v" <> tInt (evVersion e))]-      | otherwise ->-          selectorChanges oldE ++ sameVersionEventDiff oldAgg newAgg oldE e-  where-    selectorChanges oldEvent = eventFieldSelectorChanges oldAgg newAgg oldEvent e---- | Events present in the old aggregate but absent in the new one. Removing a--- tag entirely is breaking; deprecation preserves decoding but needs a retained--- replay-only emitter to preserve replay.-removedEvents :: Aggregate -> Aggregate -> [Change]-removedEvents oldAgg newAgg =-  [ breaking (aggName newAgg) "event" (evName oldE) EvtRemovedNotDeprecated "event removed entirely; its stored payloads can neither decode nor replay. Deprecating instead restores decode-ability only — replay still fails on live streams unless an equivalent replay-only emitting transition is retained; truncate or terminalize affected streams before deleting it"-  | oldE <- aggEvents oldAgg,-    isNothing (find ((== evName oldE) . evName) (aggEvents newAgg))-  ]--hasSource :: Maybe (Int, Hole) -> Int -> Bool-hasSource (Just (m, _)) n = m == n-hasSource Nothing _ = False--aggregateHasUpcasterSource :: Aggregate -> Int -> Bool-aggregateHasUpcasterSource aggregate source =-  any ((== Just source) . fmap fst . evUpcastFrom) (aggEvents aggregate)--hasReplayOnlyEmitter :: Aggregate -> Name -> Bool-hasReplayOnlyEmitter aggregate eventName =-  any-    (\transition -> tMode transition == TmReplayOnly && eventName `elem` tEmits transition)-    (aggTransitions aggregate)--data EventFieldSig = EventFieldSig-  { eventFieldDslName :: !Name,-    eventFieldSelector :: !Name,-    eventFieldWireKey :: !Text,-    eventFieldType :: !(Maybe TypeExpr)-  }-  deriving stock (Eq, Show)--eventFieldSigs :: Aggregate -> Event -> [EventFieldSig]-eventFieldSigs agg e = case evBody e of-  EventFields fs -> map fieldSig fs-  EventFromCommand cn ->-    maybe [] (map fieldSig . cmdFields) (find ((== cn) . cmdName) (aggCommands agg))-  where-    fieldSig field =-      let identity = resolveAggregateFieldIdentity field-       in EventFieldSig-            { eventFieldDslName = fieldDslName identity,-              eventFieldSelector = fieldSelector identity,-              eventFieldWireKey = fieldWireKey identity,-              eventFieldType = aggregateFieldType field-            }--eventFieldSelectorChanges :: Aggregate -> Aggregate -> Event -> Event -> [Change]-eventFieldSelectorChanges oldAggregate newAggregate oldEvent newEvent =-  [ fieldSelectorChange-      (aggName newAggregate)-      "event-field-selector"-      (evName newEvent <> "." <> eventFieldDslName newField)-      (eventFieldSelector oldField)-      (eventFieldSelector newField)-      "event field selector"-  | newField <- eventFieldSigs newAggregate newEvent,-    Just oldField <- [find ((== eventFieldDslName newField) . eventFieldDslName) (eventFieldSigs oldAggregate oldEvent)],-    eventFieldSelector oldField /= eventFieldSelector newField-  ]--commandFieldIdentityDiff :: Aggregate -> Aggregate -> [Change]-commandFieldIdentityDiff oldAggregate newAggregate =-  [ fieldSelectorChange-      (aggName newAggregate)-      "command-field-selector"-      (cmdName newCommand <> "." <> aggregateFieldName newField)-      (fieldSelector (resolveAggregateFieldIdentity oldField))-      (fieldSelector (resolveAggregateFieldIdentity newField))-      "command field selector"-  | newCommand <- aggCommands newAggregate,-    Just oldCommand <- [find ((== cmdName newCommand) . cmdName) (aggCommands oldAggregate)],-    newField <- cmdFields newCommand,-    Just oldField <- [find ((== aggregateFieldName newField) . aggregateFieldName) (cmdFields oldCommand)],-    fieldSelector (resolveAggregateFieldIdentity oldField)-      /= fieldSelector (resolveAggregateFieldIdentity newField)-  ]--sameVersionEventDiff :: Aggregate -> Aggregate -> Event -> Event -> [Change]-sameVersionEventDiff oldAgg newAgg oldE newE =-  addedChanges-    ++ removedChanges-    ++ typeChanges-    ++ wireKeyChanges-    ++ deprecationChanges-    ++ retirementChanges-  where-    oldFields = eventFieldSigs oldAgg oldE-    newFields = eventFieldSigs newAgg newE-    oldNames = map eventFieldDslName oldFields-    newNames = map eventFieldDslName newFields-    added = newNames \\ oldNames-    removed = oldNames \\ newNames-    changed =-      [ (eventFieldDslName oldField, eventFieldType oldField, eventFieldType newField)-      | oldField <- oldFields,-        Just newField <- [find ((== eventFieldDslName oldField) . eventFieldDslName) newFields],-        eventFieldType oldField /= eventFieldType newField-      ]-    addedChanges =-      [ breaking (aggName newAgg) "event" (evName newE) EvtFieldAddedWithoutBump ("field(s) " <> commas added <> " added at the same version v" <> tInt (evVersion newE) <> " without a version bump or upcaster")-      | not (null added)-      ]-    removedChanges =-      [ breaking (aggName newAgg) "event" (evName newE) EvtFieldRemovedSameVersion ("field(s) " <> commas removed <> " removed at the same version v" <> tInt (evVersion newE))-      | not (null removed)-      ]-    typeChanges =-      [ breaking-          (aggName newAgg)-          "event-field"-          (evName newE <> "." <> field)-          EvtFieldTypeChanged-          ("type changed " <> renderAggregateFieldType oldType <> " -> " <> renderAggregateFieldType newType <> " at the same version v" <> tInt (evVersion newE))-      | (field, oldType, newType) <- changed-      ]-    wireKeyChanges =-      [ breaking-          (aggName newAgg)-          "event-field-wire-key"-          (evName newE <> "." <> eventFieldDslName newField)-          EvtFieldWireKeyChanged-          ( "wire key changed '"-              <> eventFieldWireKey oldField-              <> "' -> '"-              <> eventFieldWireKey newField-              <> "'; restore the old key, or version the event and retain an upcaster"-          )-      | newField <- newFields,-        Just oldField <- [find ((== eventFieldDslName newField) . eventFieldDslName) oldFields],-        eventFieldWireKey oldField /= eventFieldWireKey newField-      ]-    deprecationChanges-      | not (evDeprecated oldE) && evDeprecated newE =-          [ if hasReplayOnlyEmitter newAgg (evName newE)-              then-                advisory-                  (aggName newAgg)-                  "event"-                  (evName newE)-                  EventRetirementInProgress-                  "event deprecated and removed from the live write path, while an equivalent replay-only transition preserves hydration. Retain that transition until every affected stream is terminal, truncated, or passes the replay audit"-              else-                advisory-                  (aggName newAgg)-                  "event"-                  (evName newE)-                  DeprecatedEventReplayHazard-                  ( "event deprecated: old payloads remain decodable but are no longer replayable — hydration of live streams containing them fails at the first command (HydrationNoInvertingEdge). Add an equivalent replay-only emitting transition or confirm every affected stream is terminal or truncated before deploying"-                      <> if evRetiring oldE then "" else "; consider a 'retiring event' stage first"-                  )-          ]-      | evDeprecated oldE && not (evDeprecated newE) && not (evRetiring newE) =-          [advisory (aggName newAgg) "event" (evName newE) EventUndeprecated "event returned to the write surface; old payloads remain decodable but new writes resume"]-      | otherwise = []-    retirementChanges-      | not (evRetiring oldE) && evRetiring newE =-          [advisory (aggName newAgg) "event" (evName newE) EventRetirementInProgress "retirement started; keep the live emitting transition until affected streams are terminal or truncated, then cut over to deprecated plus an equivalent replay-only emitting transition"]-      | evRetiring oldE && not (evRetiring newE) && not (evDeprecated newE) =-          [additive (aggName newAgg) "event" (evName newE) EventRetirementAbandoned "event retirement abandoned; ordinary live writes continue"]-      | otherwise = []--renderAggregateFieldType :: Maybe TypeExpr -> Text-renderAggregateFieldType Nothing = "(declared)"-renderAggregateFieldType (Just expression) = typeExprCanonicalName expression--renderFieldType :: Maybe Name -> Text-renderFieldType Nothing = "(declared)"-renderFieldType (Just name) = name--wireDiff :: Aggregate -> Aggregate -> [Change]-wireDiff oldAgg newAgg-  | effectiveWire (aggWire oldAgg) == effectiveWire (aggWire newAgg) = []-  | otherwise =-      [ breaking-          (aggName newAgg)-          "wire"-          (aggName newAgg)-          WireSpecChanged-          ("effective wire convention changed " <> renderWire (effectiveWire (aggWire oldAgg)) <> " -> " <> renderWire (effectiveWire (aggWire newAgg)))-      ]--effectiveWire :: Maybe WireSpec -> (Text, Text)-effectiveWire Nothing = ("ctorName", "camelCase")-effectiveWire (Just w) = (wireKind w, wireFields w)--renderWire :: (Text, Text) -> Text-renderWire (kindName, fieldNames) = "kind=" <> kindName <> ", fields=" <> fieldNames--projectionDiff :: Aggregate -> Aggregate -> [Change]-projectionDiff oldAggregate newAggregate-  | projectionSurface (aggProjection oldAggregate) == projectionSurface (aggProjection newAggregate) = []-  | otherwise =-      [ advisory-          (aggName newAggregate)-          "projection"-          (aggName newAggregate)-          ProjectionChanged-          "projection table, consistency, key, or status mapping changed; coordinate the read-model migration"-      ]--projectionSurface :: Maybe ProjectionSpec -> Maybe (Name, Maybe Consistency, Name, Maybe Mapping)-projectionSurface projection = do-  value <- projection-  pure (projTable value, projConsistency value, projKey value, projStatusMap value)--idDiff :: DiffEnv -> [Change]-idDiff env =-  concatMap (uncurry (idPairDiff (deOld env))) (prMatched paired)-    ++ concatMap addedIdDiff (prAdded paired)-    ++ concatMap removedIdDiff (prRemoved paired)-  where-    paired = pairDeclarations idName (specIds (deOld env)) (specIds (deNew env))--idPairDiff :: Spec -> IdDecl -> IdDecl -> [Change]-idPairDiff oldSpec oldId newId =-  [ breaking (idName newId) "id-prefix" (idName newId) IdPrefixChanged ("prefix changed '" <> idPrefix oldId <> "' -> '" <> idPrefix newId <> "'; stored and newly minted ids no longer share an identity domain")-  | idPrefix oldId /= idPrefix newId-  ]-    <> nominalBindingDeclDiff oldSpec "id" (idName newId) (idBinding oldId) (idBinding newId)-    <> [ nominalUseChange-           use-           NominalIdDecoderTightened-           "adopting a checked KindID binding tightens historical decoding; keep a committed valid old-payload fixture and run the targeted real-log audit for this event"-       | idBinding oldId == Nothing,-         isJust (idBinding newId),-         use@NominalEventUse {} <- nominalUses oldSpec (idName oldId)-       ]--addedIdDiff :: IdDecl -> [Change]-addedIdDiff declaration = [additive (idName declaration) "id-prefix" (idName declaration) DeclarationAdded "new id declaration"]--removedIdDiff :: IdDecl -> [Change]-removedIdDiff declaration = [breaking (idName declaration) "id-prefix" (idName declaration) IdPrefixChanged "id declaration removed; persisted ids still use its prefix"]--enumDiff :: DiffEnv -> [Change]-enumDiff env =-  concatMap (uncurry (enumPairDiff (deOld env))) (prMatched paired)-    ++ concatMap addedEnumDiff (prAdded paired)-    ++ concatMap (removedEnumDiff (deOld env)) (prRemoved paired)-  where-    paired = pairDeclarations enumName (specEnums (deOld env)) (specEnums (deNew env))--enumPairDiff :: Spec -> EnumDecl -> EnumDecl -> [Change]-enumPairDiff oldSpec oldEnum newEnum =-  [ breaking (enumName newEnum) "enum-constructor" ctor EnumCtorRemoved ("constructor removed; stored wire value '" <> wire <> "' no longer decodes" <> enumUsageSuffix oldSpec (enumName oldEnum))-  | (ctor, wire) <- enumCtors oldEnum,-    isNothing (lookup ctor (enumCtors newEnum))-  ]-    ++ [ breaking (enumName newEnum) "enum-constructor" ctor EnumWireSpellingChanged ("wire spelling changed '" <> oldWire <> "' -> '" <> newWire <> "'; stored values using the old spelling no longer decode" <> enumUsageSuffix oldSpec (enumName oldEnum))-       | (ctor, oldWire) <- enumCtors oldEnum,-         Just newWire <- [lookup ctor (enumCtors newEnum)],-         oldWire /= newWire-       ]-    ++ concat-      [ enumAdditionDiff oldSpec newEnum ctor wire-      | (ctor, wire) <- enumCtors newEnum,-        isNothing (lookup ctor (enumCtors oldEnum))-      ]-      <> nominalBindingDeclDiff oldSpec "enum" (enumName newEnum) (enumBinding oldEnum) (enumBinding newEnum)--nominalScalarDiff :: DiffEnv -> [Change]-nominalScalarDiff env =-  concatMap (uncurry scalarPairDiff) (prMatched paired)-    <> [nominalDeclarationChange (nominalScalarName declaration) DeclarationAdded "new nominal scalar declaration" | declaration <- prAdded paired]-    <> [nominalDeclarationChange (nominalScalarName declaration) NominalRepresentationChanged "nominal scalar declaration removed while persisted uses may remain" | declaration <- prRemoved paired]-  where-    paired = pairDeclarations nominalScalarName (specNominalScalars (deOld env)) (specNominalScalars (deNew env))-    scalarPairDiff oldDeclaration newDeclaration =-      [ nominalDeclarationChange-          (nominalScalarName newDeclaration)-          NominalRepresentationChanged-          ( "nominal scalar representation changed '"-              <> nominalScalarRepresentation oldDeclaration-              <> "' -> '"-              <> nominalScalarRepresentation newDeclaration-              <> "'"-          )-      | nominalScalarRepresentation oldDeclaration /= nominalScalarRepresentation newDeclaration-      ]-        <> nominalBindingDeclDiff-          (deOld env)-          "scalar"-          (nominalScalarName newDeclaration)-          (Just (nominalScalarBinding oldDeclaration))-          (Just (nominalScalarBinding newDeclaration))--data NominalUse-  = NominalCommandUse !Name !Name !Name-  | NominalEventUse !Name !Name !Name-  | NominalRegisterUse !Name !Name--nominalUses :: Spec -> Name -> [NominalUse]-nominalUses spec target = concatMap usesInAggregate [aggregate | NAggregate aggregate <- specNodes spec]-  where-    usesInAggregate aggregate =-      [ NominalCommandUse (aggName aggregate) (cmdName command) (aggregateFieldName field)-      | command <- aggCommands aggregate,-        field <- cmdFields command,-        fieldReferences target field-      ]-        <> [ NominalEventUse (aggName aggregate) (evName event) (aggregateFieldName field)-           | event <- aggEvents aggregate,-             field <- eventFields aggregate event,-             fieldReferences target field-           ]-        <> [ NominalRegisterUse (aggName aggregate) (regName register)-           | register <- aggRegs aggregate,-             regType register == TRef target-           ]-    eventFields aggregate event = case evBody event of-      EventFields fields -> fields-      EventFromCommand commandName -> concat [cmdFields command | command <- aggCommands aggregate, cmdName command == commandName]-    fieldReferences targetName field = case aggregateFieldType field of-      Just (TRef typeName) -> typeName == targetName-      Just _ -> False-      Nothing -> pascalName (aggregateFieldName field) == targetName-    pascalName value = case T.uncons value of-      Nothing -> value-      Just (initialChar, rest) -> T.cons (toUpper initialChar) rest--nominalBindingDeclDiff :: Spec -> Text -> Name -> Maybe NominalBindingDecl -> Maybe NominalBindingDecl -> [Change]-nominalBindingDeclDiff oldSpec category name oldBinding newBinding =-  concat-    [ nominalFinding NominalBindingChanged "binding source, symbol, or version changed; rebuild every consumer use and audit persisted event uses because hand-written conversion behavior is opaque"-    | bindingRuntimeFacts oldBinding /= bindingRuntimeFacts newBinding-    ]-    <> concat-      [ nominalFinding NominalFixturesChanged "fixture symbol changed; rerun nominal conformance without claiming runtime wire behavior changed"-      | (nominalFixtures =<< oldBinding) /= (nominalFixtures =<< newBinding)-      ]-    <> concat-      [ nominalFinding NominalCanonicalTypeChanged "canonical nominal identity changed; rebuild consumers and invalidate snapshot caches at register uses"-      | (nominalCanonicalType =<< oldBinding) /= (nominalCanonicalType =<< newBinding)-      ]-    <> concat-      [ nominalFinding NominalInitialChanged "consumer-owned initial value symbol changed; rebuild and invalidate snapshot-bearing register streams"-      | (nominalInitial =<< oldBinding) /= (nominalInitial =<< newBinding)-      ]-  where-    bindingRuntimeFacts declaration =-      ( nominalHaskell =<< declaration,-        nominalBinding =<< declaration,-        nominalBindingVersion =<< declaration-      )-    nominalFinding code detail =-      nominalDeclarationChange name code (category <> " " <> detail)-        : [nominalUseChange use code detail | use <- nominalUses oldSpec name, includeUse code use]-    includeUse NominalFixturesChanged _ = False-    includeUse NominalCanonicalTypeChanged NominalRegisterUse {} = True-    includeUse NominalCanonicalTypeChanged _ = False-    includeUse NominalInitialChanged NominalRegisterUse {} = True-    includeUse NominalInitialChanged _ = False-    includeUse _ NominalCommandUse {} = False-    includeUse _ _ = True--nominalDeclarationChange :: Name -> DiagnosticCode -> Text -> Change-nominalDeclarationChange name code detail =-  mkChange-    (deriveLabel defaultGate vector)-    context-    name-    "nominal-build"-    name-    code-    detail-  where-    context = (consumerBuildContext name [name]) {contextOriginalLabel = LabelAdvisory}-    vector = classifyCompatibility context code--nominalUseChange :: NominalUse -> DiagnosticCode -> Text -> Change-nominalUseChange use code detail =-  mkChange (deriveLabel defaultGate vector) context root facet subject code detail-  where-    (root, facet, subject, kind) = case use of-      NominalCommandUse aggregate command field -> (aggregate, "nominal-command", aggregate <> " command " <> command <> " ." <> field, ContextConsumerBuild)-      NominalEventUse aggregate event field -> (aggregate, "nominal-event", aggregate <> " event " <> event <> " ." <> field, ContextPrivateEvent)-      NominalRegisterUse aggregate register -> (aggregate, "nominal-register", aggregate <> " register " <> register, ContextSnapshot)-    context = ChangeContext root [subject] kind LabelAdvisory-    vector = classifyCompatibility context code--addedEnumDiff :: EnumDecl -> [Change]-addedEnumDiff enumDecl =-  [additive (enumName enumDecl) "enum-constructor" ctor EnumCtorAdded ("new enum constructor with wire spelling '" <> wire <> "'") | (ctor, wire) <- enumCtors enumDecl]--enumAdditionDiff :: Spec -> EnumDecl -> Name -> Text -> [Change]-enumAdditionDiff oldSpec enumDecl ctor wire = case enumUsages oldSpec (enumName enumDecl) of-  [] ->-    [ additive-        (enumName enumDecl)-        "enum-constructor"-        ctor-        EnumCtorAdded-        ("new constructor with wire spelling '" <> wire <> "'")-    ]-  usages -> map finding usages-  where-    finding usage-      | ".reg." `T.isInfixOf` usage =-          advisoryAt-            (snapshotContext (enumName enumDecl) [usage])-            (enumName enumDecl)-            "enum-constructor"-            ctor-            EnumCtorAdded-            ("new constructor with wire spelling '" <> wire <> "' is used by " <> usage <> "; invalidate or rebuild snapshots before values using the new arm hydrate")-      | otherwise =-          advisoryAt-            (privateEventAdditionContext (enumName enumDecl) [usage])-            (enumName enumDecl)-            "enum-constructor"-            ctor-            EnumCtorAdded-            ("new constructor with wire spelling '" <> wire <> "' is used by " <> usage <> "; deploy consumers before producers emit the new arm")--removedEnumDiff :: Spec -> EnumDecl -> [Change]-removedEnumDiff oldSpec enumDecl =-  [ breaking (enumName enumDecl) "enum-constructor" ctor EnumCtorRemoved ("enum removed; stored wire value '" <> wire <> "' no longer decodes" <> enumUsageSuffix oldSpec (enumName enumDecl))-  | (ctor, wire) <- enumCtors enumDecl-  ]--enumUsageSuffix :: Spec -> Name -> Text-enumUsageSuffix spec enumType = case enumUsages spec enumType of-  [] -> ""-  usages -> "; used by " <> commas usages--enumUsages :: Spec -> Name -> [Text]-enumUsages spec enumType =-  [aggName agg <> ".reg." <> regName reg | agg <- aggregates, reg <- aggRegs agg, regType reg == TRef enumType]-    ++ [ aggName agg <> ".event." <> evName event <> "." <> eventFieldDslName field-       | agg <- aggregates,-         event <- aggEvents agg,-         field <- eventFieldSigs agg event,-         Just fieldTypeName <- [eventFieldType field],-         fieldTypeName == TRef enumType-       ]-  where-    aggregates = [agg | NAggregate agg <- specNodes spec]--pairDeclarations :: (n -> Name) -> [n] -> [n] -> Paired n-pairDeclarations nameOf oldNodes newNodes =-  Paired-    { prMatched =-        [ (oldNode, newNode)-        | newNode <- newNodes,-          Just oldNode <- [find ((== nameOf newNode) . nameOf) oldNodes]-        ],-      prAdded = [newNode | newNode <- newNodes, isNothing (find ((== nameOf newNode) . nameOf) oldNodes)],-      prRemoved = [oldNode | oldNode <- oldNodes, isNothing (find ((== nameOf oldNode) . nameOf) newNodes)]-    }--contractDiff :: DiffEnv -> [Change]-contractDiff env =-  concatMap (uncurry contractPairDiff) (prMatched paired)-    ++ concatMap addedContractDiff (prAdded paired)-    ++ concatMap removedContractDiff (prRemoved paired)-  where-    paired = pairByName nodeContract ctrName env--contractPairDiff :: ContractNode -> ContractNode -> [Change]-contractPairDiff oldContract newContract =-  schemaChanges-    ++ discriminatorChanges-    ++ topicChanges-    ++ concatMap eventPairChanges matchedEvents-    ++ concatMap addedEventChanges addedEvents-    ++ concatMap removedEventChanges removedEvents'-  where-    schemaChanges =-      [ breaking-          (ctrName newContract)-          "schema-version"-          (ctrName newContract)-          ContractSchemaVersionDecreased-          ("schemaVersion decreased from " <> tInt (ctrSchemaVersion oldContract) <> " to " <> tInt (ctrSchemaVersion newContract))-      | ctrSchemaVersion newContract < ctrSchemaVersion oldContract-      ]-    discriminatorChanges =-      [ breaking-          (ctrName newContract)-          "discriminator"-          (ctrName newContract)-          ContractDiscriminatorChanged-          ("discriminator changed " <> ctrDiscriminator oldContract <> " -> " <> ctrDiscriminator newContract)-      | ctrDiscriminator oldContract /= ctrDiscriminator newContract-      ]-    topicChanges = contractTopicDiff oldContract newContract-    eventPairs = pairDeclarations ceName (ctrEvents oldContract) (ctrEvents newContract)-    matchedEvents = prMatched eventPairs-    addedEvents = prAdded eventPairs-    removedEvents' = prRemoved eventPairs-    eventPairChanges (oldEvent, newEvent) = contractEventDiff oldContract newContract oldEvent newEvent-    addedEventChanges event =-      [additive (ctrName newContract) "contract-event" (ceName event) ContractEventAdded "new contract event"]-    removedEventChanges event =-      [breaking (ctrName newContract) "contract-event" (ceName event) ContractEventRemoved "contract event removed; existing cross-service payloads no longer have a declared decoder"]--addedContractDiff :: ContractNode -> [Change]-addedContractDiff contract =-  [additive (ctrName contract) "contract-event" (ceName event) ContractEventAdded "new event in a new contract" | event <- ctrEvents contract]--removedContractDiff :: ContractNode -> [Change]-removedContractDiff contract =-  [breaking (ctrName contract) "contract-event" (ceName event) ContractEventRemoved "contract removed; its cross-service event decoder is no longer declared" | event <- ctrEvents contract]--contractTopicDiff :: ContractNode -> ContractNode -> [Change]-contractTopicDiff oldContract newContract =-  [ breaking-      (ctrName newContract)-      "contract-topic"-      alias-      ContractTopicChanged-      ("topic alias removed; previous topic was '" <> oldTopic <> "'")-  | (alias, oldTopic) <- ctrTopics oldContract,-    isNothing (lookup alias (ctrTopics newContract))-  ]-    ++ [ breaking-           (ctrName newContract)-           "contract-topic"-           alias-           ContractTopicChanged-           ("real topic changed '" <> oldTopic <> "' -> '" <> newTopic <> "'")-       | (alias, oldTopic) <- ctrTopics oldContract,-         Just newTopic <- [lookup alias (ctrTopics newContract)],-         oldTopic /= newTopic-       ]-    ++ [ additive (ctrName newContract) "contract-topic" alias ContractTopicAdded ("new topic alias for '" <> topic <> "'")-       | (alias, topic) <- ctrTopics newContract,-         isNothing (lookup alias (ctrTopics oldContract))-       ]--contractEventDiff :: ContractNode -> ContractNode -> ContractEvent -> ContractEvent -> [Change]-contractEventDiff oldContract newContract oldEvent newEvent =-  topicAliasChange-    ++ removedFieldChanges-    ++ changedFieldChanges-    ++ selectorFieldChanges-    ++ wireKeyFieldChanges-    ++ addedFieldChanges-  where-    fieldPairs = pairDeclarations cfName (ceFields oldEvent) (ceFields newEvent)-    topicAliasChange =-      [ breaking-          (ctrName newContract)-          "contract-topic"-          (ceName newEvent)-          ContractTopicChanged-          ("event topic alias changed " <> ceTopic oldEvent <> " -> " <> ceTopic newEvent)-      | ceTopic oldEvent /= ceTopic newEvent-      ]-    removedFieldChanges =-      [ breaking (ctrName newContract) "contract-field" (ceName newEvent <> "." <> cfName field) ContractFieldChanged "field removed; existing messages still carry the old contract shape"-      | field <- prRemoved fieldPairs-      ]-    changedFieldChanges =-      [ breaking-          (ctrName newContract)-          "contract-field"-          (ceName newEvent <> "." <> cfName newField)-          ContractFieldChanged-          ("field type changed " <> renderContractType (cfType oldField) <> " -> " <> renderContractType (cfType newField))-      | (oldField, newField) <- prMatched fieldPairs,-        cfType oldField /= cfType newField-      ]-    selectorFieldChanges =-      [ fieldSelectorChange-          (ctrName newContract)-          "contract-field-selector"-          (ceName newEvent <> "." <> cfName newField)-          (fieldSelector (resolveContractFieldIdentity oldField))-          (fieldSelector (resolveContractFieldIdentity newField))-          "contract field selector"-      | (oldField, newField) <- prMatched fieldPairs,-        fieldSelector (resolveContractFieldIdentity oldField)-          /= fieldSelector (resolveContractFieldIdentity newField)-      ]-    wireKeyFieldChanges =-      [ breaking-          (ctrName newContract)-          "contract-field"-          (ceName newEvent <> "." <> cfName newField)-          ContractFieldChanged-          ( "wire key changed '"-              <> fieldWireKey (resolveContractFieldIdentity oldField)-              <> "' -> '"-              <> fieldWireKey (resolveContractFieldIdentity newField)-              <> "'; restore the old key or revise the public contract with a consumer-first rollout"-          )-      | (oldField, newField) <- prMatched fieldPairs,-        fieldWireKey (resolveContractFieldIdentity oldField)-          /= fieldWireKey (resolveContractFieldIdentity newField)-      ]-    addedFieldChanges =-      [ if ctrSchemaVersion newContract > ctrSchemaVersion oldContract-          then advisory (ctrName newContract) "contract-field" subject ContractSchemaVersionBumped ("field added with schemaVersion bump " <> tInt (ctrSchemaVersion oldContract) <> " -> " <> tInt (ctrSchemaVersion newContract) <> "; coordinate the cross-service rollout")-          else breaking (ctrName newContract) "contract-field" subject ContractFieldChanged "field added without a schemaVersion bump; older in-flight messages do not contain it"-      | field <- prAdded fieldPairs,-        let subject = ceName newEvent <> "." <> cfName field-      ]--renderContractType :: ContractType -> Text-renderContractType (CTypeId prefix) = "typeid '" <> prefix <> "'"-renderContractType CText = "text"-renderContractType CInt = "int"--workqueueDiff :: DiffEnv -> [Change]-workqueueDiff env =-  concatMap (uncurry workqueuePairDiff) (prMatched paired)-    ++ concatMap addedWorkqueueDiff (prAdded paired)-    ++ concatMap removedWorkqueueDiff (prRemoved paired)-  where-    paired = pairWorkqueues env---- | Prefer source identity, then pair a uniquely renamed queue by its complete--- explicit runtime identity. This permits a generated module-segment rename to--- remain a build-only finding without guessing when an external identity is--- ambiguous.-pairWorkqueues :: DiffEnv -> Paired WorkqueueNode-pairWorkqueues env =-  Paired-    { prMatched = exact <> fallback,-      prAdded = [queue | queue <- unmatchedNew, queue `notElem` map snd fallback],-      prRemoved = [queue | queue <- unmatchedOld, queue `notElem` map fst fallback]-    }-  where-    oldQueues = mapMaybe nodeWorkqueue (specNodes (deOld env))-    newQueues = mapMaybe nodeWorkqueue (specNodes (deNew env))-    exact =-      [ (oldQueue, newQueue)-      | newQueue <- newQueues,-        Just oldQueue <- [find ((== wqName newQueue) . wqName) oldQueues]-      ]-    exactOldNames = map (wqName . fst) exact-    exactNewNames = map (wqName . snd) exact-    unmatchedOld = [queue | queue <- oldQueues, wqName queue `notElem` exactOldNames]-    unmatchedNew = [queue | queue <- newQueues, wqName queue `notElem` exactNewNames]-    fallback =-      [ (oldQueue, newQueue)-      | newQueue <- unmatchedNew,-        let matchingOld = [queue | queue <- unmatchedOld, queueIdentity queue == queueIdentity newQueue],-        [oldQueue] <- [matchingOld],-        length [queue | queue <- unmatchedNew, queueIdentity queue == queueIdentity newQueue] == 1-      ]--workqueuePairDiff :: WorkqueueNode -> WorkqueueNode -> [Change]-workqueuePairDiff oldQueue newQueue =-  generatedNameChanges-    ++ concatMap pairedFieldDiff (prMatched fields)-    ++ concatMap addedFieldDiff (prAdded fields)-    ++ concatMap removedFieldDiff (prRemoved fields)-    ++ queueIdentityDiff oldQueue newQueue-    ++ queuePolicyDiff oldQueue newQueue-  where-    generatedNameChanges =-      [ generatedNameChange-          (wqName newQueue)-          "workqueue-module"-          (wqName newQueue)-          (wqName oldQueue)-          (wqName newQueue)-          "workqueue module segment"-      | wqName oldQueue /= wqName newQueue,-        normalizedGeneratedUpper (wqName oldQueue) /= normalizedGeneratedUpper (wqName newQueue)-      ]-        ++ [ generatedNameChange-               (wqName newQueue)-               "workqueue-payload-type"-               (wqPayloadName newQueue)-               (wqPayloadName oldQueue)-               (wqPayloadName newQueue)-               "workqueue payload type"-           | wqPayloadName oldQueue /= wqPayloadName newQueue,-             normalizedGeneratedUpper (wqPayloadName oldQueue) /= normalizedGeneratedUpper (wqPayloadName newQueue)-           ]-    fields = pairDeclarations wqfName (wqPayload oldQueue) (wqPayload newQueue)-    pairedFieldDiff (oldField, newField)-      | wqfWire oldField /= wqfWire newField = [payloadBreaking newField ("wire name changed '" <> wqfWire oldField <> "' -> '" <> wqfWire newField <> "'")]-      | wqfType oldField /= wqfType newField = [payloadBreaking newField ("type changed " <> renderQueuePayloadType (wqfType oldField) <> " -> " <> renderQueuePayloadType (wqfType newField))]-      | otherwise = []-    renderQueuePayloadType (LegacyQueueScalar scalar) = queueScalarName scalar-    renderQueuePayloadType (TypedQueueExpression expression) = typeExprCanonicalName expression-    -- Every payload field is required, so adding one always breaks jobs already-    -- queued under the old shape; there is no optional variant to strengthen.-    addedFieldDiff field = [payloadBreaking field "new required field; queued jobs do not contain it"]-    removedFieldDiff field = [payloadBreaking field "field removed; queued jobs still contain the old payload shape"]-    payloadBreaking field detail =-      withMappedConsequences-        (Set.fromList [MappedConsumerBuild consumer, MappedWorkqueueHistory (wqName newQueue)])-        (breaking (wqName newQueue) "payload-field" (wqfName field) WqPayloadFieldChanged detail)-      where-        consumer = WorkqueueConsumer (wqName newQueue)--addedWorkqueueDiff :: WorkqueueNode -> [Change]-addedWorkqueueDiff queue =-  [additive (wqName queue) "payload-field" (wqfName field) DeclarationAdded "field belongs to a new workqueue payload" | field <- wqPayload queue]--removedWorkqueueDiff :: WorkqueueNode -> [Change]-removedWorkqueueDiff queue =-  [breaking (wqName queue) "payload-field" (wqfName field) WqPayloadFieldChanged "workqueue removed while persisted jobs may still carry this payload" | field <- wqPayload queue]-    ++ [breaking (wqName queue) "queue-identity" (wqName queue) QueueIdentityChanged "workqueue removed; its physical queue, DLQ, and pgmq table may still hold state"]--queueIdentityDiff :: WorkqueueNode -> WorkqueueNode -> [Change]-queueIdentityDiff oldQueue newQueue =-  [ breaking-      (wqName newQueue)-      "queue-identity"-      (wqName newQueue)-      QueueIdentityChanged-      "logical, physical, DLQ, or table name changed; queued jobs and dispatch dedupe records remain under the old identity"-  | queueIdentity oldQueue /= queueIdentity newQueue-  ]--queueIdentity :: WorkqueueNode -> (Text, Text, Text, Text)-queueIdentity queue = (wqLogical queue, wqPhysical queue, wqDlq queue, wqTable queue)--generatedNameChange :: Name -> Text -> Text -> Text -> Text -> Text -> Change-generatedNameChange node facet subject oldLogical newLogical occurrenceKind =-  advisory-    node-    facet-    subject-    GeneratedHaskellNameChanged-    ( occurrenceKind-        <> " changed '"-        <> normalizedGeneratedUpper oldLogical-        <> "' -> '"-        <> normalizedGeneratedUpper newLogical-        <> "' while wire, SQL, queue, registry, subscription, and persisted runtime identities remain unchanged; re-scaffold and recompile consumers"-    )--fieldSelectorChange :: Name -> Text -> Text -> Text -> Text -> Text -> Change-fieldSelectorChange node facet subject oldSelector newSelector occurrenceKind =-  advisory-    node-    facet-    subject-    GeneratedHaskellNameChanged-    ( occurrenceKind-        <> " changed '"-        <> oldSelector-        <> "' -> '"-        <> newSelector-        <> "' while DSL and wire identities remain unchanged; re-scaffold and recompile consumers"-    )--normalizedGeneratedUpper :: Text -> Text-normalizedGeneratedUpper logicalName =-  case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-    Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-    Left _ -> logicalName-  where-    site =-      HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedTypeSite,-          HaskellName.siteLogicalName = logicalName,-          HaskellName.siteOwner = "diff",-          HaskellName.siteLine = 0-        }--queuePolicyDiff :: WorkqueueNode -> WorkqueueNode -> [Change]-queuePolicyDiff oldQueue newQueue = ordering ++ provision ++ groupKey-  where-    nodeName = wqName newQueue-    ordering =-      [ breaking nodeName "queue-ordering" nodeName WqOrderingChanged $-          "ordering changed " <> renderWqOrdering (wqOrdering oldQueue) <> " -> " <> renderWqOrdering (wqOrdering newQueue) <> "; consumers were written against the old delivery-order contract"-      | wqOrdering oldQueue /= wqOrdering newQueue-      ]-    provision =-      [ breaking nodeName "queue-provision" nodeName WqProvisionChanged $-          "provision changed " <> renderWqProvision (wqProvision oldQueue) <> " -> " <> renderWqProvision (wqProvision newQueue) <> "; provisioning is create-time only, so migrate the existing queue operationally before changing the spec"-      | wqProvision oldQueue /= wqProvision newQueue-      ]-    groupKey =-      [ breaking nodeName "queue-group-key" nodeName WqGroupKeyChanged $-          "group key derivation changed " <> renderWqGroupKey (wqGroupKey oldQueue) <> " -> " <> renderWqGroupKey (wqGroupKey newQueue) <> "; FIFO messages are re-partitioned across durable ordering groups"-      | wqGroupKey oldQueue /= wqGroupKey newQueue-      ]--renderWqOrdering :: WqOrdering -> Text-renderWqOrdering WqUnordered = "unordered"-renderWqOrdering WqFifoThroughput = "fifo-throughput"-renderWqOrdering WqFifoRoundRobin = "fifo-roundrobin"--renderWqProvision :: WqProvision -> Text-renderWqProvision WqStandard = "standard"-renderWqProvision WqUnlogged = "unlogged"-renderWqProvision (WqPartitioned interval duration) = "partitioned(interval=" <> interval <> ", retention=" <> duration <> ")"--renderWqGroupKey :: Maybe WqGroupKey -> Text-renderWqGroupKey Nothing = "none"-renderWqGroupKey (Just groupKey) =-  gkField groupKey-    <> " via "-    <> gkVia groupKey-    <> maybe "" (" fixture " <>) (gkFixture groupKey)--processDiff :: DiffEnv -> [Change]-processDiff env =-  concatMap (uncurry processPairDiff) (prMatched paired)-    ++ concatMap addedProcessDiff (prAdded paired)-    ++ concatMap removedProcessDiff (prRemoved paired)-  where-    paired = pairByName nodeProcess procId env--processPairDiff :: ProcessNode -> ProcessNode -> [Change]-processPairDiff oldProcess newProcess =-  concatMap pairedFieldDiff (prMatched fields)-    ++ map (fieldChange "field added; source events at the old shape cannot populate it") (prAdded fields)-    ++ map (fieldChange "field removed; the generated process input decoder changed") (prRemoved fields)-    ++ processIdentityDiff oldProcess newProcess-    ++ processTimerWindowDiff oldProcess newProcess-    ++ processDecideSurfaceDiff oldProcess newProcess-    ++ processTimerPayloadDiff oldProcess newProcess-  where-    -- inName is a generated Haskell type name; the wire shape is inFields.-    fields = pairDeclarations fieldName (inFields (procInput oldProcess)) (inFields (procInput newProcess))-    pairedFieldDiff (oldField, newField)-      | fieldType oldField /= fieldType newField = [fieldChange ("type changed " <> renderFieldType (fieldType oldField) <> " -> " <> renderFieldType (fieldType newField)) newField]-      | otherwise = []-    fieldChange detail field = breaking (procId newProcess) "input-field" (fieldName field) ProcessInputChanged (detail <> "; version the source event before changing process input")--addedProcessDiff :: ProcessNode -> [Change]-addedProcessDiff process =-  [additive (procId process) "input-field" (fieldName field) DeclarationAdded "field belongs to a new process input" | field <- inFields (procInput process)]--removedProcessDiff :: ProcessNode -> [Change]-removedProcessDiff process =-  [breaking (procId process) "input-field" (fieldName field) ProcessInputChanged "process removed while persisted source events may still require this input decoder" | field <- inFields (procInput process)]-    ++ [breaking (procId process) "derived-identity" (procId process) DerivedIdentityChanged "process removed while persisted saga, dispatch, and timer identities may still exist"]--processIdentityDiff :: ProcessNode -> ProcessNode -> [Change]-processIdentityDiff oldProcess newProcess =-  [ breaking-      (procId newProcess)-      "derived-identity"-      (procId newProcess)-      DerivedIdentityChanged-      "process name, correlation derivation, saga stream category, timer id expression, or fired-event-id expression changed; replays and retries no longer derive the persisted identity"-  | processIdentity oldProcess /= processIdentity newProcess-  ]--processIdentity :: ProcessNode -> (Text, Name, Name, Text, Text, Name, Text, Name)-processIdentity process =-  ( procName process,-    corrField (procCorrelate process),-    corrVia (procCorrelate process),-    sagaCategory (procSaga process),-    idePrefix (tmId (procTimer process)),-    ideField (tmId (procTimer process)),-    idePrefix (fireFiredEventId (tmFire (procTimer process))),-    ideField (fireFiredEventId (tmFire (procTimer process)))-  )--processTimerWindowDiff :: ProcessNode -> ProcessNode -> [Change]-processTimerWindowDiff oldProcess newProcess =-  [ advisory-      (procId newProcess)-      "timer"-      (tmName (procTimer newProcess))-      TimerWindowChanged-      ( "fireAt source/window changed "-          <> renderFireAt (tmFireAt (procTimer oldProcess))-          <> " -> "-          <> renderFireAt (tmFireAt (procTimer newProcess))-          <> "; already-scheduled timers keep their persisted deadline"-      )-  | tmFireAt (procTimer oldProcess) /= tmFireAt (procTimer newProcess)-  ]--processDecideSurfaceDiff :: ProcessNode -> ProcessNode -> [Change]-processDecideSurfaceDiff oldProcess newProcess =-  [ advisory-      (procId newProcess)-      "process-decide"-      (procId newProcess)-      ProcessDecideSurfaceChanged-      "process dispatch surface changed: a source event redelivered across the deploy dispatches under the same deterministic ids, so half-old/half-new fan-out merges silently. Drain or pause the process subscription and replay or discard dead letters before deploying; see docs/user/deploy-ordering.md. Hole-only decide changes are not visible to diff; the same drain rule applies to those too."-  | renderHandleSurface (procHandle oldProcess)-      /= renderHandleSurface (procHandle newProcess)-  ]--processTimerPayloadDiff :: ProcessNode -> ProcessNode -> [Change]-processTimerPayloadDiff oldProcess newProcess =-  [ advisory-      (procId newProcess)-      "timer-payload"-      (tmName (procTimer newProcess))-      ProcessTimerPayloadChanged-      "timer payload shape changed: rows scheduled before the deploy carry the old shape, unversioned, and fire under new code — the fire decoder must accept every historically scheduled shape or the timer dead-letters after maxAttempts. Hole-only timer-decoder changes are not visible to diff; the same drain rule applies to those too."-  | renderTimerPayloadSurface (procTimer oldProcess)-      /= renderTimerPayloadSurface (procTimer newProcess)-  ]--renderFireAt :: FireAtExpr -> Text-renderFireAt expression = "input." <> faField expression <> " + " <> faWindow expression--workflowDiff :: DiffEnv -> [Change]-workflowDiff env =-  concatMap (uncurry workflowPairDiff) (prMatched paired)-    ++ concatMap addedWorkflowDiff (prAdded paired)-    ++ concatMap removedWorkflowDiff (prRemoved paired)-  where-    paired = pairByName nodeWorkflow wfId env--workflowPairDiff :: WorkflowNode -> WorkflowNode -> [Change]-workflowPairDiff oldWorkflow newWorkflow =-  inputChanges-    ++ outputChanges-    ++ classifyWorkflowBody oldWorkflow newWorkflow-    ++ workflowIdentityDiff oldWorkflow newWorkflow-  where-    fields = pairDeclarations fieldName (wfInputFields oldWorkflow) (wfInputFields newWorkflow)-    inputChanges =-      [workflowShape field "input field added; journaled inputs at the old shape do not contain it" | field <- prAdded fields]-        ++ [workflowShape field "input field removed; journaled inputs still contain the old shape" | field <- prRemoved fields]-        ++ [ workflowShape newField ("input field type changed " <> renderFieldType (fieldType oldField) <> " -> " <> renderFieldType (fieldType newField))-           | (oldField, newField) <- prMatched fields,-             fieldType oldField /= fieldType newField-           ]-    outputChanges =-      [ breaking (wfId newWorkflow) "workflow-output" (wfOutput newWorkflow) WorkflowShapeChanged ("output type changed " <> wfOutput oldWorkflow <> " -> " <> wfOutput newWorkflow <> "; persisted outcomes may no longer decode")-      | wfOutput oldWorkflow /= wfOutput newWorkflow-      ]-    workflowShape field detail = breaking (wfId newWorkflow) "workflow-input" (fieldName field) WorkflowShapeChanged detail--addedWorkflowDiff :: WorkflowNode -> [Change]-addedWorkflowDiff workflow = [additive (wfId workflow) "workflow" (wfId workflow) DeclarationAdded "new workflow"]--removedWorkflowDiff :: WorkflowNode -> [Change]-removedWorkflowDiff workflow = [breaking (wfId workflow) "workflow" (wfId workflow) WorkflowShapeChanged "workflow removed while in-flight journals and outcomes may still require its decoder"]--workflowIdentityDiff :: WorkflowNode -> WorkflowNode -> [Change]-workflowIdentityDiff oldWorkflow newWorkflow =-  [ breaking-      (wfId newWorkflow)-      "workflow-name"-      (wfId newWorkflow)-      WorkflowStableNameChanged-      ("stable name changed '" <> wfStable oldWorkflow <> "' -> '" <> wfStable newWorkflow <> "'; in-flight journals remain under the old stream name")-  | wfStable oldWorkflow /= wfStable newWorkflow-  ]-    ++ [ breaking-           (wfId newWorkflow)-           "derived-identity"-           (wfId newWorkflow)-           DerivedIdentityChanged-           "workflow id source field or derivation changed; journal and deterministic child/step identities no longer coalesce with persisted executions"-       | (wfIdField oldWorkflow, wfIdVia oldWorkflow) /= (wfIdField newWorkflow, wfIdVia newWorkflow)-       ]--intakeDiff :: DiffEnv -> [Change]-intakeDiff env =-  concatMap (uncurry intakePairDiff) (prMatched paired)-    ++ concatMap addedIntakeDiff (prAdded paired)-    ++ concatMap removedIntakeDiff (prRemoved paired)-  where-    paired = pairByName nodeIntake inkName env--intakePairDiff :: IntakeNode -> IntakeNode -> [Change]-intakePairDiff oldIntake newIntake =-  [ breaking-      (inkName newIntake)-      "dedupe-identity"-      (inkName newIntake)-      DedupeIdentityChanged-      "dedupe key or policy changed; redelivered messages no longer match their persisted dedupe record"-  | (inkDedupeKey oldIntake, inkDedupePolicy oldIntake) /= (inkDedupeKey newIntake, inkDedupePolicy newIntake)-  ]-    ++ [ advisory-           (inkName newIntake)-           "decode-posture"-           (inkName newIntake)-           DecodePostureChanged-           "envelope/body decode posture changed; future messages are accepted or rejected differently"-       | inkDecode oldIntake /= inkDecode newIntake-       ]-    ++ [ advisory-           (inkName newIntake)-           "inbox-persistence"-           (inkName newIntake)-           IntakePersistenceChanged-           ("success-path envelope persistence changed " <> renderInkPersist (inkPersist oldIntake) <> " -> " <> renderInkPersist (inkPersist newIntake) <> "; existing rows are unchanged while future successful rows retain a different envelope shape")-       | inkPersist oldIntake /= inkPersist newIntake-       ]--renderInkPersist :: InkPersist -> Text-renderInkPersist InkPersistFull = "full-envelope"-renderInkPersist InkPersistDedupeOnly = "dedupe-only"--addedIntakeDiff :: IntakeNode -> [Change]-addedIntakeDiff intake = [additive (inkName intake) "intake" (inkName intake) DeclarationAdded "new intake"]--removedIntakeDiff :: IntakeNode -> [Change]-removedIntakeDiff intake = [breaking (inkName intake) "dedupe-identity" (inkName intake) DedupeIdentityChanged "intake removed while persisted dedupe records and redeliveries may remain"]--emitDiff :: DiffEnv -> [Change]-emitDiff env =-  concatMap (uncurry emitPairDiff) (prMatched paired)-    ++ concatMap addedEmitDiff (prAdded paired)-    ++ concatMap removedEmitDiff (prRemoved paired)-  where-    paired = pairByName nodeEmit emName env--emitPairDiff :: EmitNode -> EmitNode -> [Change]-emitPairDiff oldEmit newEmit =-  [ breaking-      (emName newEmit)-      "derived-identity"-      "messageId"-      DerivedIdentityChanged-      "messageId derive prefix changed; outbox retries no longer coalesce with persisted messages"-  | emMessageId oldEmit /= emMessageId newEmit-  ]-    ++ [ breaking-           (emName newEmit)-           "derived-identity"-           "idempotencyKey"-           DerivedIdentityChanged-           "idempotencyKey derive prefix changed; downstream dedupe no longer matches persisted messages"-       | emIdempotencyKey oldEmit /= emIdempotencyKey newEmit-       ]-    ++ [ advisory-           (emName newEmit)-           "emit-mapping"-           (emName newEmit)-           EmitMappingChanged-           "emit key, status discriminant, mapping rows, or explicit skip posture changed"-       | emitMapping oldEmit /= emitMapping newEmit-       ]--emitMapping :: EmitNode -> (Name, Name, [EmitMapRow], Bool)-emitMapping emit = (emKey emit, emDiscriminant emit, emMap emit, emSkip emit)--addedEmitDiff :: EmitNode -> [Change]-addedEmitDiff emit = [additive (emName emit) "emit" (emName emit) DeclarationAdded "new emit mapping"]--removedEmitDiff :: EmitNode -> [Change]-removedEmitDiff emit = [breaking (emName emit) "derived-identity" (emName emit) DerivedIdentityChanged "emit removed while persisted outbox identities may still retry"]--publisherDiff :: DiffEnv -> [Change]-publisherDiff env =-  concatMap (uncurry publisherPairDiff) (prMatched paired)-    ++ concatMap addedPublisherDiff (prAdded paired)-    ++ concatMap removedPublisherDiff (prRemoved paired)-  where-    paired = pairByName nodePublisher pubName env--publisherPairDiff :: PublisherNode -> PublisherNode -> [Change]-publisherPairDiff oldPublisher newPublisher =-  -- maxAttempts/backoff are retry tuning, not persisted decode or identity.-  [ breaking-      (pubName newPublisher)-      "derived-identity"-      "outboxId"-      DerivedIdentityChanged-      "stable outbox-id source field changed; retries no longer coalesce with persisted outbox rows"-  | pubOutboxField oldPublisher /= pubOutboxField newPublisher-  ]-    ++ [ advisory-           (pubName newPublisher)-           "publisher-policy"-           (pubName newPublisher)-           PublisherPolicyChanged-           ("ordering changed " <> pubOrdering oldPublisher <> " -> " <> pubOrdering newPublisher)-       | pubOrdering oldPublisher /= pubOrdering newPublisher-       ]--addedPublisherDiff :: PublisherNode -> [Change]-addedPublisherDiff publisher = [additive (pubName publisher) "publisher" (pubName publisher) DeclarationAdded "new publisher"]--removedPublisherDiff :: PublisherNode -> [Change]-removedPublisherDiff publisher = [breaking (pubName publisher) "derived-identity" (pubName publisher) DerivedIdentityChanged "publisher removed while persisted outbox rows may still require its stable identity"]--pgmqDispatchDiff :: DiffEnv -> [Change]-pgmqDispatchDiff env =-  concatMap (uncurry pgmqDispatchPairDiff) (prMatched paired)-    ++ concatMap addedPgmqDispatchDiff (prAdded paired)-    ++ concatMap removedPgmqDispatchDiff (prRemoved paired)-  where-    paired = pairByName nodePgmqDispatch pdName env--pgmqDispatchPairDiff :: PgmqDispatchNode -> PgmqDispatchNode -> [Change]-pgmqDispatchPairDiff oldDispatch newDispatch =-  [ breaking-      (pdName newDispatch)-      "dedupe-identity"-      (pdName newDispatch)-      DedupeIdentityChanged-      "dispatch dedupe key/read-model/queue surface changed; prior enqueue records no longer match"-  | dispatchDedupe oldDispatch /= dispatchDedupe newDispatch-  ]-    ++ [ advisory-           (pdName newDispatch)-           "retarget"-           (pdName newDispatch)-           DispatchRetargeted-           "source read model or target queue changed; future fan-out is routed differently"-       | dispatchTargets oldDispatch /= dispatchTargets newDispatch-       ]--dispatchDedupe :: PgmqDispatchNode -> (Name, Name, Text, Name, Text)-dispatchDedupe dispatch =-  ( pdDedupKey dispatch,-    pdDedupReadModel dispatch,-    pdDedupReadModelField dispatch,-    pdDedupQueue dispatch,-    pdDedupQueueField dispatch-  )--dispatchTargets :: PgmqDispatchNode -> (Name, Name)-dispatchTargets dispatch = (pdSourceReadModel dispatch, pdEnqueueTo dispatch)--addedPgmqDispatchDiff :: PgmqDispatchNode -> [Change]-addedPgmqDispatchDiff dispatch = [additive (pdName dispatch) "dispatch" (pdName dispatch) DeclarationAdded "new pgmq dispatch"]--removedPgmqDispatchDiff :: PgmqDispatchNode -> [Change]-removedPgmqDispatchDiff dispatch = [breaking (pdName dispatch) "dedupe-identity" (pdName dispatch) DedupeIdentityChanged "dispatch removed while persisted queue and read-model dedupe records may remain"]---- | Classify the runtime's sanctioned workflow-evolution mechanisms before--- falling back to the conservative unguarded-body rule.-classifyWorkflowBody :: WorkflowNode -> WorkflowNode -> [Change]-classifyWorkflowBody oldWorkflow newWorkflow-  | oldBody == newBody = []-  | not (null removedPatchIds) = map removedPatch removedPatchIds-  | Just (oldSeedType, newSeedType) <- changedSeed =-      [ breaking nodeName "workflow-continue-as-new" nodeName WorkflowContinueSeedChanged $-          "continueAsNew seed type changed " <> oldSeedType <> " -> " <> newSeedType <> "; the next generation's restoreSeed must decode the seed written by the previous generation"-      ]-  | safeAdditions =-      map addedPatch newPatchIds-        ++ [ additive nodeName "workflow-continue-as-new" seedType WorkflowEvolutionGuardAdded "terminal continueAsNew is additive; old generations carry no rotation marker"-           | Just seedType <- [appendedSeed]-           ]-  | otherwise =-      [ breaking-          nodeName-          "workflow-body"-          nodeName-          WorkflowBodyChanged-          "workflow body labels, kinds, result types, or order changed without a new patch guard; wrap a cross-cutting change in patch, or rename the replay label for one changed step"-      ]-  where-    nodeName = wfId newWorkflow-    oldBody = normaliseWorkflowBody (wfBody oldWorkflow)-    newBody = normaliseWorkflowBody (wfBody newWorkflow)-    oldPatchIds = workflowBodyPatchIds oldBody-    newPatchIdsAll = workflowBodyPatchIds newBody-    newPatchIds = newPatchIdsAll \\ oldPatchIds-    removedPatchIds = oldPatchIds \\ newPatchIdsAll-    oldSeed = terminalContinueSeed oldBody-    newSeed = terminalContinueSeed newBody-    changedSeed = case (oldSeed, newSeed) of-      (Just oldSeedType, Just newSeedType)-        | oldSeedType /= newSeedType -> Just (oldSeedType, newSeedType)-      _ -> Nothing-    appendedSeed = case (oldSeed, newSeed) of-      (Nothing, Just seedType) -> Just seedType-      _ -> Nothing-    strippedNewBody = stripNewPatches newPatchIds newBody-    comparableNewBody = case appendedSeed of-      Just _ -> dropTerminalContinue strippedNewBody-      Nothing -> strippedNewBody-    safeAdditions =-      (not (null newPatchIds) || isJust appendedSeed)-        && comparableNewBody == oldBody-    removedPatch patchId =-      breaking nodeName "workflow-patch" patchId WorkflowPatchRemoved "patch id existed in the old spec but was removed; the differ cannot prove that no workflow generation still replays its journaled branch"-    addedPatch patchId =-      additive nodeName "workflow-patch" patchId WorkflowEvolutionGuardAdded "new patch guard contains the entire body change, so in-flight generations retain their journaled branch"--normaliseWorkflowBody :: [WfBodyItem] -> [WfBodyItem]-normaliseWorkflowBody = map go-  where-    go (WfStep label result _) = WfStep label result noLoc-    go (WfAwait label result _) = WfAwait label result noLoc-    go (WfSleep label delay _) = WfSleep label delay noLoc-    go (WfChild label via result _) = WfChild label via result noLoc-    go (WfPatch patchId items _) = WfPatch patchId (normaliseWorkflowBody items) noLoc-    go (WfContinueAsNew seedType _) = WfContinueAsNew seedType noLoc--workflowBodyPatchIds :: [WfBodyItem] -> [Name]-workflowBodyPatchIds = concatMap go-  where-    go (WfPatch patchId items _) = patchId : workflowBodyPatchIds items-    go _ = []--stripNewPatches :: [Name] -> [WfBodyItem] -> [WfBodyItem]-stripNewPatches newPatchIds = concatMap go-  where-    go (WfPatch patchId _ _) | patchId `elem` newPatchIds = []-    go (WfPatch patchId items loc) = [WfPatch patchId (stripNewPatches newPatchIds items) loc]-    go item = [item]--terminalContinueSeed :: [WfBodyItem] -> Maybe Name-terminalContinueSeed items = case reverse items of-  WfContinueAsNew seedType _ : _ -> Just seedType-  _ -> Nothing--dropTerminalContinue :: [WfBodyItem] -> [WfBodyItem]-dropTerminalContinue items = case reverse items of-  WfContinueAsNew {} : rest -> reverse rest-  _ -> items--additive :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change-additive n facet subj code detail =-  mkChange LabelAdditive (contextFor LabelAdditive n facet subj code) n facet subj code detail--breaking :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change-breaking n facet subj code detail =-  mkChange LabelBreaking (contextFor LabelBreaking n facet subj code) n facet subj code detail--advisory :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change-advisory n facet subj code detail =-  mkChange LabelAdvisory (contextFor LabelAdvisory n facet subj code) n facet subj code detail--advisoryAt :: ChangeContext -> Name -> Text -> Text -> DiagnosticCode -> Text -> Change-advisoryAt context n facet subj code detail =-  mkChange LabelAdvisory context n facet subj code detail--mkChange :: Label -> ChangeContext -> Name -> Text -> Text -> DiagnosticCode -> Text -> Change-mkChange label context n facet subj code detail =-  wrap-    ChangeKind-      { ckNode = n,-        ckFacet = facet,-        ckSubject = subj,-        ckCode = code,-        ckContext = context,-        ckVector = classifyCompatibility context code,-        ckMappedPersistedImpact = case contextKind context of-          ContextQueue -> Just (MappedPersistedImpact (WorkqueueHistory (changeContextRoot context)) VBreaking)-          _ -> Nothing,-        ckMappedConsequences = Set.empty,-        ckPaths = changeContextPaths context,-        ckDetail = detail-      }-  where-    wrap = case label of-      LabelAdditive -> Additive-      LabelAdvisory -> Advisory-      LabelBreaking -> Breaking--contextFor :: Label -> Name -> Text -> Text -> DiagnosticCode -> ChangeContext-contextFor label root facet subject code =-  setLabel $ case () of-    _-      | code `elem` publicCodes -> publicContractContext root paths-      | code `elem` queueCodes -> queueContext root paths-      | code `elem` identityCodes -> persistedIdentityContext root paths-      | code `elem` [OwnershipMoved, WorkspaceAuthorityChanged, GeneratedHaskellNameChanged] -> consumerBuildContext root paths-      | code == AggFoldSurfaceChanged -> snapshotContext root paths-      | code == EnumCtorAdded -> ChangeContext root paths ContextGeneral label-      | code `elem` privateCodes -> privateEventContext root paths-      | otherwise -> ChangeContext root paths ContextGeneral label-  where-    paths = [pathFor root facet subject]-    setLabel context = context {contextOriginalLabel = label}+    changeContextRoot,+    changeContextPaths,+    privateEventContext,+    privateEventAdditionContext,+    snapshotContext,+    queueContext,+    publicContractContext,+    persistedIdentityContext,+    consumerBuildContext,+    advisoryAt,+    classifyCompatibility,+    verdictFor,+    defaultGate,+    gateWith,+    deriveLabel,+    gatedBreaking,+    isBreaking,+    isAdvisory,+    diffSources,+    sourceLanguageChange,+    diffServices,+    mappedSemanticImpact,+    mappedSemanticImpactForServices,+    DiffEnv (..),+    NodeFamily (..),+    familyOf,+    FamilyDiff (..),+    familyRegistry,+    Paired (..),+    pairByName,+    readModelDiff,+    classifyWorkflowBody,+  )+where++import Data.Char (toUpper)+import Data.Foldable (traverse_)+import Data.List (find, sort, (\\))+import Data.Map.Strict qualified as Map+import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Keiro.Dsl.AggregateType (typeExprCanonicalName)+import Keiro.Dsl.CanonicalEncoding (canonicalDomainOutcomeTypes, canonicalTransition, canonicalTransitionOutcome)+import Keiro.Dsl.FieldIdentity+  ( ResolvedFieldIdentity (..),+    resolveAggregateFieldIdentity,+    resolveContractFieldIdentity,+  )+import Keiro.Dsl.FoldFingerprint (FoldSurfaceError, aggregateFoldSurfaceForService)+import Keiro.Dsl.Grammar+import Keiro.Dsl.HaskellName qualified as HaskellName+import Keiro.Dsl.IdDomain (IdDomainContract (..), contractIdDomainContractFor, idDomainContractFor)+import Keiro.Dsl.LanguageVersion (ParsedSource (..), SourceLanguage, declaredLanguageVersionMaybe, languageVersionText, sourceFormText)+import Keiro.Dsl.MappedDiff (MappedFinding (..), diffMapped, renderMappedSubject)+import Keiro.Dsl.PrettyPrint+  ( renderHandleSurface,+    renderResolveSurface,+    renderRouterDispatchSurface,+    renderTimerPayloadSurface,+    renderTransition,+    renderTypeExpr,+  )+import Keiro.Dsl.ProjectionMappedImpact qualified as ProjectionImpact+import Keiro.Dsl.ProjectionSupply+import Keiro.Dsl.ReadModelShape (registryNameFor, subscriptionNameFor)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedSource, checkedSpec, effectiveLanguageContract, effectiveRuntimeSemantics, legacyCheckedService)+import Keiro.Dsl.SemanticImpact (MappedConsequence (..), MappedConsumer (..), MappedImpactDelta (..), MappedQueryPosition (..), diffSemanticImpact, mappedConsumerIdentity, mappedImpactForDeclarations, semanticImpact, semanticImpactForService, semanticImpactSnapshot)+import Keiro.Dsl.TypeGraph (DerivedMappedConsumer (..), MappedKey (..), UsePath (..), UseSite (..), renderUsePath, resolveTypeGraph)+import Keiro.Dsl.Validate (DiagnosticCode (..))++-- | A classified spec change.+data Change+  = Additive ChangeKind+  | Advisory ChangeKind+  | Breaking ChangeKind+  deriving stock (Eq, Show)++-- | The stable headline classification retained by the text interface.+data Label = LabelAdditive | LabelAdvisory | LabelBreaking+  deriving stock (Eq, Show)++-- | Independently gateable compatibility questions for one finding.+data CompatibilitySurface+  = PrivateHistoryRead+  | OldBinaryReadNewEvents+  | SnapshotHydration+  | PublicConsumer+  | PersistedIdentity+  | ConsumerBuild+  deriving stock (Eq, Ord, Show, Enum, Bounded)++-- | A verdict on one surface.  Constructor order is deliberately not policy.+data SurfaceVerdict = VCompatible | VAdvisory | VBreaking | VNotApplicable+  deriving stock (Eq, Show)++-- | Deployment ordering that remains after byte compatibility is classified.+data RolloutConstraint+  = RolloutStopTheWorld+  | RolloutWorkersFirst+  | RolloutDrainRequired+  | RolloutProducerLast+  | RolloutProducerFirst+  deriving stock (Eq, Ord, Show)++-- | The explicit, compile-forcing compatibility result for one finding.+data CompatibilityVector = CompatibilityVector+  { privateHistoryRead :: !SurfaceVerdict,+    oldBinaryReadNewEvents :: !SurfaceVerdict,+    snapshotHydration :: !SurfaceVerdict,+    publicConsumer :: !SurfaceVerdict,+    persistedIdentity :: !SurfaceVerdict,+    consumerBuild :: !SurfaceVerdict,+    rollout :: !(Set RolloutConstraint)+  }+  deriving stock (Eq, Show)++-- | Persisted mapped payloads that must not be conflated merely because the+-- compatibility vector predates first-class queue history.+data MappedPersistedSurface+  = PrivateEventHistory+  | SnapshotCache+  | WorkqueueHistory !Name+  deriving stock (Eq, Ord, Show)++data MappedPersistedImpact = MappedPersistedImpact+  { surface :: !MappedPersistedSurface,+    verdict :: !SurfaceVerdict+  }+  deriving stock (Eq, Show)++data ContextKind+  = ContextGeneral+  | ContextPrivateEvent+  | ContextPrivateEventAddition+  | ContextSnapshot+  | ContextQueue+  | ContextPublicContract+  | ContextPersistedIdentity+  | ContextConsumerBuild+  deriving stock (Eq, Show)++-- | Facts that select a compatibility row.  The constructor stays private so+-- callers cannot manufacture contradictory ownership and surface claims.+data ChangeContext = ChangeContext+  { root :: !Name,+    paths :: ![Text],+    contextKind :: !ContextKind,+    contextOriginalLabel :: !Label+  }+  deriving stock (Eq, Show)++changeContextRoot :: ChangeContext -> Name+changeContextRoot = (.root)++changeContextPaths :: ChangeContext -> [Text]+changeContextPaths = (.paths)++data ChangeKind = ChangeKind+  { node :: !Name,+    facet :: !Text,+    subject :: !Text,+    code :: !DiagnosticCode,+    context :: !ChangeContext,+    vector :: !CompatibilityVector,+    mappedPersistedImpact :: !(Maybe MappedPersistedImpact),+    mappedConsequences :: !(Set MappedConsequence),+    paths :: ![Text],+    detail :: !Text+  }+  deriving stock (Eq, Show)++privateEventContext :: Name -> [Text] -> ChangeContext+privateEventContext root paths = ChangeContext root paths ContextPrivateEvent LabelBreaking++privateEventAdditionContext :: Name -> [Text] -> ChangeContext+privateEventAdditionContext root paths = ChangeContext root paths ContextPrivateEventAddition LabelAdvisory++snapshotContext :: Name -> [Text] -> ChangeContext+snapshotContext root paths = ChangeContext root paths ContextSnapshot LabelAdvisory++queueContext :: Name -> [Text] -> ChangeContext+queueContext root paths = ChangeContext root paths ContextQueue LabelBreaking++publicContractContext :: Name -> [Text] -> ChangeContext+publicContractContext root paths = ChangeContext root paths ContextPublicContract LabelBreaking++persistedIdentityContext :: Name -> [Text] -> ChangeContext+persistedIdentityContext root paths = ChangeContext root paths ContextPersistedIdentity LabelBreaking++consumerBuildContext :: Name -> [Text] -> ChangeContext+consumerBuildContext root paths = ChangeContext root paths ContextConsumerBuild LabelAdvisory++compatibleVector :: CompatibilityVector+compatibleVector =+  CompatibilityVector+    VCompatible+    VCompatible+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VNotApplicable+    Set.empty++sourceProvenanceVector :: CompatibilityVector+sourceProvenanceVector =+  CompatibilityVector+    VCompatible+    VCompatible+    VCompatible+    VCompatible+    VCompatible+    VCompatible+    Set.empty++privateDecodeBreakingVector :: CompatibilityVector+privateDecodeBreakingVector =+  CompatibilityVector+    VBreaking+    VBreaking+    VAdvisory+    VNotApplicable+    VNotApplicable+    VNotApplicable+    (Set.singleton RolloutStopTheWorld)++persistedIdentityBreakingVector :: CompatibilityVector+persistedIdentityBreakingVector =+  CompatibilityVector+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VBreaking+    VNotApplicable+    Set.empty++publicBreakingVector :: CompatibilityVector+publicBreakingVector =+  CompatibilityVector+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VBreaking+    VNotApplicable+    VNotApplicable+    (Set.singleton RolloutProducerLast)++queueBreakingVector :: CompatibilityVector+queueBreakingVector =+  CompatibilityVector+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VBreaking+    (Set.fromList [RolloutWorkersFirst, RolloutDrainRequired])++catalogCheckpointPolicyVector :: CompatibilityVector+catalogCheckpointPolicyVector =+  CompatibilityVector+    VCompatible+    VCompatible+    VNotApplicable+    VNotApplicable+    VCompatible+    VBreaking+    (Set.singleton RolloutStopTheWorld)++advisoryVector :: CompatibilitySurface -> Set RolloutConstraint -> CompatibilityVector+advisoryVector surface rollout =+  CompatibilityVector+    { privateHistoryRead = verdict PrivateHistoryRead,+      oldBinaryReadNewEvents = verdict OldBinaryReadNewEvents,+      snapshotHydration = verdict SnapshotHydration,+      publicConsumer = verdict PublicConsumer,+      persistedIdentity = verdict PersistedIdentity,+      consumerBuild = verdict ConsumerBuild,+      rollout+    }+  where+    verdict candidate+      | candidate == surface = VAdvisory+      | otherwise = verdictFor candidate compatibleVector++replaceConsumerBuild :: SurfaceVerdict -> CompatibilityVector -> CompatibilityVector+replaceConsumerBuild consumerBuild vector =+  CompatibilityVector+    vector.privateHistoryRead+    vector.oldBinaryReadNewEvents+    vector.snapshotHydration+    vector.publicConsumer+    vector.persistedIdentity+    consumerBuild+    vector.rollout++replaceSnapshotHydration :: SurfaceVerdict -> CompatibilityVector -> CompatibilityVector+replaceSnapshotHydration snapshotHydration vector =+  CompatibilityVector+    vector.privateHistoryRead+    vector.oldBinaryReadNewEvents+    snapshotHydration+    vector.publicConsumer+    vector.persistedIdentity+    vector.consumerBuild+    vector.rollout++replaceRollout :: Set RolloutConstraint -> CompatibilityVector -> CompatibilityVector+replaceRollout rollout vector =+  CompatibilityVector+    vector.privateHistoryRead+    vector.oldBinaryReadNewEvents+    vector.snapshotHydration+    vector.publicConsumer+    vector.persistedIdentity+    vector.consumerBuild+    rollout++replaceOldBinaryAndRollout :: SurfaceVerdict -> Set RolloutConstraint -> CompatibilityVector -> CompatibilityVector+replaceOldBinaryAndRollout oldBinaryReadNewEvents rollout vector =+  CompatibilityVector+    vector.privateHistoryRead+    oldBinaryReadNewEvents+    vector.snapshotHydration+    vector.publicConsumer+    vector.persistedIdentity+    vector.consumerBuild+    rollout++-- | Classify one code at an explicitly owned use site.  Codes emitted by the+-- differ are grouped by their actual persisted/public surface; the context is+-- load-bearing for codes such as 'EnumCtorAdded' that vary by use site.+classifyCompatibility :: ChangeContext -> DiagnosticCode -> CompatibilityVector+classifyCompatibility context code+  | code == SourceLanguageDeclarationChanged = sourceProvenanceVector+  | code == GeneratedHaskellNameChanged = replaceConsumerBuild VAdvisory sourceProvenanceVector+  | code `elem` [OwnershipMoved, WorkspaceAuthorityChanged] = mappedBuildVector+  | code `elem` [ReadModelQueryInputChanged, ReadModelQueryResultChanged] =+      replaceConsumerBuild VBreaking compatibleVector+  | code == MappedFieldAddedWithDefault = mappedFieldAdditionVector context+  | code `elem` [MappedArmAdded, MappedEnumValueAdded] = mappedDirectionalAdditionVector context+  | code `elem` mappedWireBreakingCodes = mappedWireBreakingVector context+  | code `elem` [MappedHaskellSourceChanged, MappedRecordConstructorChanged, MappedFixturesChanged] = mappedBuildVector+  | code == MappedBindingChanged = mappedBindingVector context+  | code `elem` [MappedInitialChanged, MappedCanonicalTypeChanged] = mappedSnapshotBuildVector context+  | code == NominalFixturesChanged = mappedBuildVector+  | code == NominalBindingChanged = mappedBindingVector context+  | code `elem` [NominalInitialChanged, NominalCanonicalTypeChanged] = mappedSnapshotBuildVector context+  | code == NominalRepresentationChanged = mappedWireBreakingVector context+  | code == NominalIdDecoderTightened =+      replaceConsumerBuild VAdvisory (advisoryVector PrivateHistoryRead Set.empty)+  | code == ContractTypeIdDomainChanged = contractTypeIdDomainVector+  | code == IdDomainContractChanged = idDomainContractVector+  | code == MappedDeclAdded = compatibleVector+  | code `elem` privateDecodeCodes = privateDecodeBreakingVector+  | code `elem` identityCodes = persistedIdentityBreakingVector+  | code `elem` publicBreakingCodes = publicBreakingVector+  | code `elem` queueBreakingCodes = queueBreakingVector+  | code `elem` readModelBreakingCodes = persistedIdentityBreakingVector+  | code `elem` catalogIdentityCodes = persistedIdentityBreakingVector+  | code `elem` catalogReplayCodes = privateDecodeBreakingVector+  | code == CatalogCheckpointPolicyChanged = catalogCheckpointPolicyVector+  | code `elem` [ProjectionDeliveryChanged, QueryFreshnessChanged] = persistedIdentityBreakingVector+  | code == CatalogHandlerOrderChanged =+      replaceConsumerBuild VAdvisory (advisoryVector PrivateHistoryRead Set.empty)+  | code == ContractSchemaVersionBumped = advisoryVector PublicConsumer (Set.singleton RolloutProducerLast)+  | code == AggFoldSurfaceChanged =+      replaceSnapshotHydration VAdvisory (advisoryVector PrivateHistoryRead Set.empty)+  | code == AggGuardTightened = advisoryVector PrivateHistoryRead Set.empty+  | code `elem` [RouterDecideSurfaceChanged, ProcessDecideSurfaceChanged] =+      replaceRollout (Set.singleton RolloutDrainRequired) compatibleVector+  | code == ProcessTimerPayloadChanged = advisoryVector PrivateHistoryRead (Set.singleton RolloutProducerLast)+  | code == TimerWindowChanged = advisoryVector PrivateHistoryRead Set.empty+  | code == ProjectionChanged = advisoryVector PersistedIdentity Set.empty+  | code == EmitMappingChanged = advisoryVector PublicConsumer (Set.singleton RolloutProducerLast)+  | code == DecodePostureChanged = advisoryVector PublicConsumer Set.empty+  | code == IntakePersistenceChanged = advisoryVector PrivateHistoryRead Set.empty+  | code `elem` [PublisherPolicyChanged, DispatchRetargeted] = advisoryVector PersistedIdentity Set.empty+  | code `elem` [DeprecatedEventReplayHazard, EventRetirementInProgress] = advisoryVector PrivateHistoryRead Set.empty+  | code == EventUndeprecated = advisoryVector OldBinaryReadNewEvents (Set.singleton RolloutProducerLast)+  | code == EnumCtorAdded = case (.contextKind) context of+      ContextPrivateEventAddition ->+        replaceOldBinaryAndRollout VBreaking (Set.singleton RolloutProducerLast) compatibleVector+      ContextSnapshot -> advisoryVector SnapshotHydration Set.empty+      _ -> compatibleVector+  | code `elem` additiveCodes = compatibleVector+  | otherwise = case (.contextOriginalLabel) context of+      LabelAdditive -> compatibleVector+      LabelAdvisory -> advisoryVector (surfaceForContext context) Set.empty+      LabelBreaking -> breakingVectorForContext context+  where+    privateDecodeCodes =+      [ EvtFieldAddedWithoutBump,+        EvtFieldRemovedSameVersion,+        EvtFieldWireKeyChanged,+        EvtFieldTypeChanged,+        EvtVersionDecreased,+        EvtVersionMissingUpcaster,+        UpcasterChainGap,+        EvtRemovedNotDeprecated,+        EnumCtorRemoved,+        EnumWireSpellingChanged,+        WireSpecChanged,+        ProcessInputChanged,+        WorkflowShapeChanged,+        WorkflowBodyChanged,+        WorkflowPatchRemoved,+        WorkflowContinueSeedChanged+      ]++    identityCodes =+      [ DerivedIdentityChanged,+        IdPrefixChanged,+        DedupeIdentityChanged,+        QueueIdentityChanged,+        RouterStableNameChanged,+        WorkflowStableNameChanged+      ]+    publicBreakingCodes =+      [ ContractEventRemoved,+        ContractFieldChanged,+        ContractDiscriminatorChanged,+        ContractTopicChanged,+        ContractSchemaVersionDecreased+      ]+    queueBreakingCodes = [WqPayloadFieldChanged, WqOrderingChanged, WqProvisionChanged, WqGroupKeyChanged]+    readModelBreakingCodes =+      [ ReadModelVersionDecreased,+        ReadModelShapeChangedWithoutBump,+        ReadModelFeedChanged,+        ReadModelConsistencyWeakened+      ]+    catalogIdentityCodes =+      [ CatalogTargetRemoved,+        CatalogTargetLocationChanged,+        CatalogTargetDependencyChanged,+        CatalogGroupChanged,+        CatalogOwnerRemoved,+        CatalogFeedIdentityChanged,+        CatalogQueryBindingChanged,+        ProjectionDeliveryChanged,+        QueryFreshnessChanged+      ]+    catalogReplayCodes = [CatalogSourceChanged, CatalogReplayPolicyChanged]+    additiveCodes =+      [ DeclarationAdded,+        VersionBumped,+        CompatibilityStrengthened,+        EventRetirementAbandoned,+        ContractEventAdded,+        ContractTopicAdded,+        WorkflowEvolutionGuardAdded+      ]++idDomainContractVector :: CompatibilityVector+idDomainContractVector =+  CompatibilityVector+    { privateHistoryRead = VCompatible,+      oldBinaryReadNewEvents = VCompatible,+      snapshotHydration = VAdvisory,+      publicConsumer = VBreaking,+      persistedIdentity = VCompatible,+      consumerBuild = VAdvisory,+      rollout = Set.singleton RolloutProducerLast+    }++contractTypeIdDomainVector :: CompatibilityVector+contractTypeIdDomainVector =+  CompatibilityVector+    { privateHistoryRead = VNotApplicable,+      oldBinaryReadNewEvents = VNotApplicable,+      snapshotHydration = VNotApplicable,+      publicConsumer = VBreaking,+      persistedIdentity = VNotApplicable,+      consumerBuild = VBreaking,+      rollout = Set.fromList [RolloutDrainRequired, RolloutProducerFirst]+    }++mappedWireBreakingCodes :: [DiagnosticCode]+mappedWireBreakingCodes =+  [ MappedFieldAddedNoDefault,+    MappedFieldRemoved,+    MappedFieldTypeChanged,+    MappedPresenceChanged,+    MappedNullabilityChanged,+    MappedDefaultRemoved,+    MappedDefaultChanged,+    MappedWireKeyChanged,+    MappedUnionEncodingChanged,+    MappedArmRemoved,+    MappedArmTagChanged,+    MappedEnumValueRemoved,+    MappedEnumSpellingChanged,+    MappedOpaqueCodecChanged,+    MappedModeCrossed,+    MappedDeclRemoved+  ]++mappedFieldAdditionVector :: ChangeContext -> CompatibilityVector+mappedFieldAdditionVector context = case (.contextKind) context of+  ContextPrivateEvent ->+    replaceOldBinaryAndRollout oldBinaryVerdict rollout compatibleVector+    where+      rejectsUnknown = (.contextOriginalLabel) context == LabelBreaking+      oldBinaryVerdict = if rejectsUnknown then VBreaking else VCompatible+      rollout = if rejectsUnknown then Set.singleton RolloutProducerLast else Set.empty+  ContextSnapshot -> mappedSnapshotVector+  ContextQueue -> queueBreakingVector+  ContextConsumerBuild -> mappedBuildVector+  _ -> compatibleVector++mappedDirectionalAdditionVector :: ChangeContext -> CompatibilityVector+mappedDirectionalAdditionVector context = case (.contextKind) context of+  ContextPrivateEvent ->+    replaceOldBinaryAndRollout VBreaking (Set.singleton RolloutProducerLast) compatibleVector+  ContextSnapshot -> mappedSnapshotVector+  ContextQueue -> queueBreakingVector+  ContextConsumerBuild -> mappedBuildVector+  _ -> compatibleVector++mappedWireBreakingVector :: ChangeContext -> CompatibilityVector+mappedWireBreakingVector context = case (.contextKind) context of+  ContextPrivateEvent ->+    CompatibilityVector+      VBreaking+      VBreaking+      VNotApplicable+      VNotApplicable+      VNotApplicable+      VNotApplicable+      (Set.singleton RolloutStopTheWorld)+  ContextSnapshot -> mappedSnapshotVector+  ContextQueue -> queueBreakingVector+  ContextConsumerBuild -> mappedBuildVector+  _ -> mappedBuildVector++mappedBuildVector :: CompatibilityVector+mappedBuildVector =+  CompatibilityVector+    VCompatible+    VCompatible+    VNotApplicable+    VNotApplicable+    VNotApplicable+    VAdvisory+    Set.empty++mappedSnapshotVector :: CompatibilityVector+mappedSnapshotVector =+  CompatibilityVector+    VCompatible+    VCompatible+    VAdvisory+    VNotApplicable+    VNotApplicable+    VNotApplicable+    Set.empty++mappedBindingVector :: ChangeContext -> CompatibilityVector+mappedBindingVector context = case (.contextKind) context of+  ContextPrivateEvent ->+    CompatibilityVector+      VAdvisory+      VAdvisory+      VNotApplicable+      VNotApplicable+      VNotApplicable+      VAdvisory+      Set.empty+  ContextSnapshot ->+    replaceConsumerBuild VAdvisory mappedSnapshotVector+  ContextQueue -> queueBreakingVector+  _ -> mappedBuildVector++mappedSnapshotBuildVector :: ChangeContext -> CompatibilityVector+mappedSnapshotBuildVector context = case (.contextKind) context of+  ContextSnapshot -> replaceConsumerBuild VAdvisory mappedSnapshotVector+  _ -> mappedBuildVector++surfaceForContext :: ChangeContext -> CompatibilitySurface+surfaceForContext context = case (.contextKind) context of+  ContextPrivateEvent -> PrivateHistoryRead+  ContextPrivateEventAddition -> OldBinaryReadNewEvents+  ContextSnapshot -> SnapshotHydration+  ContextQueue -> PrivateHistoryRead+  ContextPublicContract -> PublicConsumer+  ContextPersistedIdentity -> PersistedIdentity+  ContextConsumerBuild -> ConsumerBuild+  ContextGeneral -> PrivateHistoryRead++breakingVectorForContext :: ChangeContext -> CompatibilityVector+breakingVectorForContext context = case (.contextKind) context of+  ContextPublicContract -> publicBreakingVector+  ContextPersistedIdentity -> persistedIdentityBreakingVector+  ContextQueue -> queueBreakingVector+  ContextConsumerBuild -> (advisoryVector ConsumerBuild Set.empty) {consumerBuild = VBreaking}+  _ -> privateDecodeBreakingVector++verdictFor :: CompatibilitySurface -> CompatibilityVector -> SurfaceVerdict+verdictFor surface vector = case surface of+  PrivateHistoryRead -> (.privateHistoryRead) vector+  OldBinaryReadNewEvents -> (.oldBinaryReadNewEvents) vector+  SnapshotHydration -> (.snapshotHydration) vector+  PublicConsumer -> (.publicConsumer) vector+  PersistedIdentity -> (.persistedIdentity) vector+  ConsumerBuild -> (.consumerBuild) vector++defaultGate :: Set CompatibilitySurface+defaultGate = Set.delete OldBinaryReadNewEvents (Set.fromList [minBound .. maxBound])++gateWith :: [CompatibilitySurface] -> Set CompatibilitySurface+gateWith surfaces = defaultGate <> Set.fromList surfaces++deriveLabel :: Set CompatibilitySurface -> CompatibilityVector -> Label+deriveLabel gate vector+  | any ((== VBreaking) . (`verdictFor` vector)) (Set.toList gate) = LabelBreaking+  | any (`elem` [VAdvisory, VBreaking]) verdicts || not (Set.null ((.rollout) vector)) = LabelAdvisory+  | otherwise = LabelAdditive+  where+    verdicts = [verdictFor surface vector | surface <- [minBound .. maxBound]]++gatedBreaking :: Set CompatibilitySurface -> Change -> Bool+gatedBreaking gate change = deriveLabel gate ((.vector) (changeKind change)) == LabelBreaking++changeKind :: Change -> ChangeKind+changeKind (Additive kind) = kind+changeKind (Advisory kind) = kind+changeKind (Breaking kind) = kind++isBreaking :: Change -> Bool+isBreaking (Breaking _) = True+isBreaking (Additive _) = False+isBreaking (Advisory _) = False++isAdvisory :: Change -> Bool+isAdvisory (Advisory _) = True+isAdvisory (Additive _) = False+isAdvisory (Breaking _) = False++-- | Both specs supplied to a node-family differ, always old then new.+data DiffEnv = DiffEnv+  { old :: !Spec,+    new :: !Spec+  }+  deriving stock (Eq, Show)++-- | The closed set of node families currently present in 'Node'.+data NodeFamily+  = FamAggregate+  | FamProcess+  | FamRouter+  | FamContract+  | FamIntake+  | FamEmit+  | FamPublisher+  | FamWorkqueue+  | FamPgmqDispatch+  | FamReadModel+  | FamProjectionTarget+  | FamRebuildGroup+  | FamProjectionRevision+  | FamExternalRead+  | FamProjectionOwner+  | FamWorkflow+  | FamOperation+  deriving stock (Eq, Ord, Show, Enum, Bounded)++-- | Total by construction: one explicit arm per 'Node' constructor.+familyOf :: Node -> NodeFamily+familyOf (NAggregate _) = FamAggregate+familyOf (NProcess _) = FamProcess+familyOf (NRouter _) = FamRouter+familyOf (NContract _) = FamContract+familyOf (NIntake _) = FamIntake+familyOf (NEmit _) = FamEmit+familyOf (NPublisher _) = FamPublisher+familyOf (NWorkqueue _) = FamWorkqueue+familyOf (NPgmqDispatch _) = FamPgmqDispatch+familyOf (NReadModel _) = FamReadModel+familyOf (NProjectionTarget _) = FamProjectionTarget+familyOf (NRebuildGroup _) = FamRebuildGroup+familyOf (NProjectionRevision _) = FamProjectionRevision+familyOf (NExternalRead _) = FamExternalRead+familyOf (NProjectionOwner _) = FamProjectionOwner+familyOf (NWorkflow _) = FamWorkflow+familyOf (NOperation _) = FamOperation++-- | A family either has a differ or an explicit reason it is not compared.+data FamilyDiff+  = DiffFamily (DiffEnv -> [Change])+  | OutOfDiffScope Text++-- | Pair the old and new declarations of one node family by stable name.+data Paired n = Paired+  { matched :: ![(n, n)],+    added :: ![n],+    removed :: ![n]+  }+  deriving stock (Eq, Show)++pairByName :: (Node -> Maybe n) -> (n -> Name) -> DiffEnv -> Paired n+pairByName project nameOf env =+  Paired+    { matched =+        [ (oldNode, newNode)+        | newNode <- newNodes,+          Just oldNode <- [find ((== nameOf newNode) . nameOf) oldNodes]+        ],+      added =+        [ newNode+        | newNode <- newNodes,+          isNothing (find ((== nameOf newNode) . nameOf) oldNodes)+        ],+      removed =+        [ oldNode+        | oldNode <- oldNodes,+          isNothing (find ((== nameOf oldNode) . nameOf) newNodes)+        ]+    }+  where+    oldNodes = mapMaybe project ((.nodes) ((.old) env))+    newNodes = mapMaybe project ((.nodes) ((.new) env))++-- | Registry invariant: every 'Node' constructor maps to a family via the+-- total 'familyOf' case, and every family occurs exactly once here.  The unit+-- suite enforces registry coverage and non-empty out-of-scope rationales.+familyRegistry :: [(NodeFamily, FamilyDiff)]+familyRegistry =+  [ (FamAggregate, DiffFamily aggregateDiff),+    (FamProcess, DiffFamily processDiff),+    (FamRouter, DiffFamily routerDiff),+    (FamContract, DiffFamily contractDiff),+    (FamIntake, DiffFamily intakeDiff),+    (FamEmit, DiffFamily emitDiff),+    (FamPublisher, DiffFamily publisherDiff),+    (FamWorkqueue, DiffFamily workqueueDiff),+    (FamPgmqDispatch, DiffFamily pgmqDispatchDiff),+    (FamReadModel, DiffFamily readModelDiff),+    (FamProjectionTarget, DiffFamily projectionTargetDiff),+    (FamRebuildGroup, DiffFamily rebuildGroupDiff),+    (FamProjectionRevision, DiffFamily projectionRevisionDiff),+    (FamExternalRead, DiffFamily externalReadDiff),+    (FamProjectionOwner, DiffFamily projectionOwnerDiff),+    (FamWorkflow, DiffFamily workflowDiff),+    (FamOperation, OutOfDiffScope "operations own no persisted decode or identity surface; their references and workflow signal/await pairing are single-spec validation concerns")+  ]++-- | Compare two graphs under their effective semantic contracts. The ordinary+-- graph differ runs first; service-aware admission and fold findings then expose+-- semantic-profile changes that leave the normalized graph itself unchanged.+diffServices :: CheckedService -> CheckedService -> Either FoldSurfaceError [Change]+diffServices oldService newService = do+  traverse_ (aggregateFoldSurfaceForService oldService . snd) oldAggregates+  traverse_ (aggregateFoldSurfaceForService newService . snd) newAggregates+  semanticContractFoldChanges <- fmap concat (traverse semanticContractFoldChange oldAggregates)+  pure (diffCheckedSpecs oldSpec newSpec <> idDomainContractChanges <> contractTypeIdDomainChanges <> semanticContractFoldChanges)+  where+    oldSpec = checkedSpec oldService+    newSpec = checkedSpec newService+    oldAggregates = [((.name) aggregate, aggregate) | NAggregate aggregate <- (.nodes) oldSpec]+    newAggregates = [((.name) aggregate, aggregate) | NAggregate aggregate <- (.nodes) newSpec]+    idDomainContractChanges =+      [ breaking+          ((.name) newDeclaration)+          "id-domain-contract"+          ((.name) newDeclaration)+          IdDomainContractChanged+          ( "ID admission contract changed "+              <> renderIdDomainContract oldContract+              <> " -> "+              <> renderIdDomainContract newContract+              <> "; public construction, command decoding, current JSON codecs, and literals use the new contract; historical event replay retains its legacy decoder; old snapshots miss and rebuild from readable events, while rebuilt state that still contains legacy-invalid text remains intentionally uncacheable until overwritten or explicitly migrated"+          )+      | newDeclaration <- (.ids) newSpec,+        Just oldDeclaration <- [find ((== (.name) newDeclaration) . (.name)) ((.ids) oldSpec)],+        let oldContract = idDomainContractFor (checkedLanguageContract oldService) ((.prefix) oldDeclaration),+        let newContract = idDomainContractFor (checkedLanguageContract newService) ((.prefix) newDeclaration),+        oldContract /= newContract+      ]+    contractTypeIdDomainChanges =+      [ breaking+          ((.name) newContract)+          "contract-typeid-domain"+          ((.name) newEvent <> "." <> (.name) newField)+          ContractTypeIdDomainChanged+          ( renderContractIdDomainChange+              ((.valueType) newField)+              oldContract+              newContract'+          )+      | newContract <- [contract | NContract contract <- (.nodes) newSpec],+        Just oldContractNode <- [find ((== (.name) newContract) . (.name)) [contract | NContract contract <- (.nodes) oldSpec]],+        newEvent <- (.events) newContract,+        Just oldEvent <- [find ((== (.name) newEvent) . (.name)) ((.events) oldContractNode)],+        newField <- (.fields) newEvent,+        Just oldField <- [find ((== (.name) newField) . (.name)) ((.fields) oldEvent)],+        (.valueType) oldField == (.valueType) newField,+        let oldContract = contractFieldIdDomain (checkedLanguageContract oldService) oldField,+        let newContract' = contractFieldIdDomain (checkedLanguageContract newService) newField,+        oldContract /= newContract'+      ]+    semanticContractFoldChange (name, oldAggregate) = case lookup name newAggregates of+      Nothing -> pure []+      Just newAggregate -> do+        oldLegacySurface <- aggregateFoldSurfaceForService (legacyCheckedService oldSpec) oldAggregate+        newLegacySurface <- aggregateFoldSurfaceForService (legacyCheckedService newSpec) newAggregate+        oldSurface <- aggregateFoldSurfaceForService oldService oldAggregate+        newSurface <- aggregateFoldSurfaceForService newService newAggregate+        pure+          [ advisory+              name+              "semantic-contract"+              name+              AggFoldSurfaceChanged+              "effective runtime semantics changed the aggregate fold surface even though the normalized graph is unchanged; re-scaffold, redeploy, and audit replay under the candidate contract"+          | oldLegacySurface == newLegacySurface,+            oldSurface /= newSurface+          ]++renderIdDomainContract :: Maybe IdDomainContract -> Text+renderIdDomainContract Nothing = "legacy-unchecked"+renderIdDomainContract (Just contract) =+  idDomainVersion contract <> "(prefix=" <> idDomainPrefix contract <> ",json=" <> idDomainJsonRepresentation contract <> ")"++contractFieldIdDomain :: EffectiveLanguageContract -> ContractField -> Maybe IdDomainContract+contractFieldIdDomain languageContract field = case (.valueType) field of+  CTypeId prefix -> contractIdDomainContractFor languageContract prefix+  _ -> Nothing++renderContractIdDomainChange :: ContractType -> Maybe IdDomainContract -> Maybe IdDomainContract -> Text+renderContractIdDomainChange valueType oldContract newContract =+  "contract TypeID admission changed "+    <> renderIdDomainContract oldContract+    <> " -> "+    <> renderIdDomainContract newContract+    <> representationChange+  where+    prefix = case valueType of+      CTypeId value -> value+      _ -> ""+    representationChange = case (oldContract, newContract) of+      (Nothing, Just _) ->+        "; generated Haskell changes from Text to KindID \""+          <> prefix+          <> "\" while valid JSON stays canonical text; newly generated consumers reject malformed, wrong-prefix, non-canonical, and non-v7 values"+      (Just _, Nothing) ->+        "; generated Haskell changes from KindID \""+          <> prefix+          <> "\" to Text and the generated decoder no longer enforces the frozen TypeID-v7 domain"+      _ -> "; generated contract admission changed while the source field type remained unchanged"++diffCheckedSpecs :: Spec -> Spec -> [Change]+diffCheckedSpecs old new =+  sharedDeclarationDiff env+    ++ concatMap (runFamily env . snd) familyRegistry+  where+    env = DiffEnv old new++-- | Compare provenance first, then delegate semantic graphs to 'diffServices'.+diffSources :: ParsedSource -> ParsedSource -> Either FoldSurfaceError [Change]+diffSources old new = do+  semanticChanges <- diffServices (checkedSource old) (checkedSource new)+  pure+    ( sourceLanguageChange+        ((.context) ((.spec) new))+        "declaration"+        ((.sourceLanguage) old)+        ((.sourceLanguage) new)+        <> semanticChanges+    )++-- | One all-compatible source-provenance finding, reusable per workspace member.+sourceLanguageChange :: Name -> Text -> SourceLanguage -> SourceLanguage -> [Change]+sourceLanguageChange root subject old new+  | old == new = []+  | otherwise =+      [ mkChange+          LabelAdditive+          (ChangeContext root [] ContextGeneral LabelAdditive)+          root+          "source-language"+          subject+          SourceLanguageDeclarationChanged+          ( "source form changed "+              <> renderSourceLanguage old+              <> " -> "+              <> renderSourceLanguage new+              <> if oldRuntime == newRuntime+                then "; normalized runtime semantics are unchanged"+                else "; effective runtime semantics changed " <> oldRuntime <> " -> " <> newRuntime <> "; see the accompanying semantic-contract findings"+          )+      ]+  where+    oldRuntime = effectiveRuntimeSemantics (effectiveLanguageContract old)+    newRuntime = effectiveRuntimeSemantics (effectiveLanguageContract new)+    renderSourceLanguage sourceLanguage =+      sourceFormText sourceLanguage+        <> maybe "" ((" v" <>) . languageVersionText) (declaredLanguageVersionMaybe sourceLanguage)++runFamily :: DiffEnv -> FamilyDiff -> [Change]+runFamily env (DiffFamily f) = f env+runFamily _ (OutOfDiffScope _) = []++-- Rules are outside the decode and persisted-identity axes, but referenced+-- rule bodies are compared as part of each aggregate's replay fold surface.+sharedDeclarationDiff :: DiffEnv -> [Change]+sharedDeclarationDiff env = enumDiff env ++ idDiff env ++ nominalScalarDiff env ++ mappedDeclarationDiff env++mappedDeclarationDiff :: DiffEnv -> [Change]+mappedDeclarationDiff env =+  concatMap+    (\finding -> mappedFindingChanges finding <> mappedProjectionFindingChanges env finding)+    (diffMapped ((.old) env) ((.new) env))++-- | A mapped event finding retains its existing private-history change and+-- gains one build/review finding per real inline/catalog aggregate consumer.+-- Category/all owners never appear because they have no single mapped event+-- authority. Operational targets and observers are evidence, not SQL claims.+mappedProjectionFindingChanges :: DiffEnv -> MappedFinding -> [Change]+mappedProjectionFindingChanges env finding = case (projectionImpactFor ((.old) env), projectionImpactFor ((.new) env)) of+  (Nothing, Nothing) -> []+  (oldImpact, newImpact) ->+    let derivedConsumers =+          maybe Set.empty (`ProjectionImpact.projectionConsumersFor` declarationKey) oldImpact+            <> maybe Set.empty (`ProjectionImpact.projectionConsumersFor` declarationKey) newImpact+     in [ withMappedConsequences (projectionConsequences derived oldOperation newOperation) $+            appendChangeDetail (operationDetail oldOperation newOperation) $+              mappedChange+                (consumerBuildContext root inheritedPaths)+                root+                "mapped-projection"+                subject+                finding+        | derived <- Set.toAscList derivedConsumers,+          let oldOperation = oldImpact >>= operationFor declarationKey derived,+          let newOperation = newImpact >>= operationFor declarationKey derived,+          let inheritedPaths =+                Set.toAscList . Set.fromList $+                  projectionPaths declarationKey derived oldImpact+                    <> projectionPaths declarationKey derived newImpact,+          let root = projectionConsumerRoot derived,+          let subject = mappedConsumerIdentity (DerivedProjectionConsumer derived) <> " inherits " <> (.unMappedKey) declarationKey+        ]+  where+    declarationKey = MappedKey ((.declaration) finding)+    projectionImpactFor spec = case resolveTypeGraph spec of+      Left _ -> Nothing+      Right graph -> Just (ProjectionImpact.projectionMappedImpact (legacyCheckedService spec) (semanticImpact graph))+    operationFor key derived impact =+      find+        (\(ProjectionImpact.ProjectionOperationalImpact candidate _ _ _ _ _) -> candidate == derived)+        (ProjectionImpact.projectionOperationsFor impact key)+    projectionPaths key derived = maybe [] $ \impact ->+      sort . Set.toList . Set.fromList $+        [ renderUsePath inheritedPath+        | ProjectionImpact.ProjectionMappedRoot candidate declaration inheritedPath <- (.roots) impact,+          candidate == derived,+          declaration == key+        ]+    operationDetail oldOperation newOperation =+      "; derived projection impact: "+        <> renderOperation "previous" oldOperation+        <> "; "+        <> renderOperation "current" newOperation+    renderOperation label Nothing = label <> "=(absent)"+    renderOperation label (Just (ProjectionImpact.ProjectionOperationalImpact _ groupName targetNames observerNames canReplay fingerprint)) =+      label+        <> "=(group="+        <> maybe "(inline)" id groupName+        <> ", targets=["+        <> T.intercalate "," (Set.toAscList targetNames)+        <> "], read-models=["+        <> T.intercalate "," (Set.toAscList observerNames)+        <> "], replayable="+        <> (if canReplay then "yes" else "no")+        <> ", source-fingerprint="+        <> fingerprint+        <> ")"+    appendChangeDetail suffix = \case+      Additive kind -> Additive (appendKindDetail suffix kind)+      Advisory kind -> Advisory (appendKindDetail suffix kind)+      Breaking kind -> Breaking (appendKindDetail suffix kind)+    appendKindDetail suffix ChangeKind {node, facet, subject, code, context, vector, mappedPersistedImpact, mappedConsequences, paths, detail} =+      ChangeKind {node, facet, subject, code, context, vector, mappedPersistedImpact, mappedConsequences, paths, detail = detail <> suffix}+    projectionConsequences derived oldOperation newOperation =+      Set.fromList+        ( [MappedConsumerBuild (DerivedProjectionConsumer derived), MappedProjectionHandlerReview derived]+            <> [ MappedProjectionRebuild derived groupName+               | ProjectionImpact.ProjectionOperationalImpact _ (Just groupName) _ _ True _ <- maybeToList oldOperation <> maybeToList newOperation+               ]+        )+    projectionConsumerRoot (AggregateInlineProjectionConsumer aggregate _) = aggregate+    projectionConsumerRoot (CatalogProjectionConsumer owner _) = owner++-- | Explain only declarations for which the authoritative mapped differ emits+-- a finding. The compatibility findings remain unchanged; this projection adds+-- the checked before/after aggregate consumer sets and service-conformance role.+mappedSemanticImpact :: Spec -> Spec -> [MappedImpactDelta]+mappedSemanticImpact oldSpec newSpec = mappedSemanticImpactForServices (legacyCheckedService oldSpec) (legacyCheckedService newSpec)++-- | Service-aware mapped impact adds checked declarative selection consumers;+-- the legacy Spec-only entry point retains its historical language contract.+mappedSemanticImpactForServices :: CheckedService -> CheckedService -> [MappedImpactDelta]+mappedSemanticImpactForServices oldService newService = case (resolveTypeGraph oldSpec, resolveTypeGraph newSpec) of+  (Right oldGraph, Right newGraph) ->+    let oldSnapshot = semanticImpactSnapshot (semanticImpactForService oldService oldGraph)+        newSnapshot = semanticImpactSnapshot (semanticImpactForService newService newGraph)+        declarationChanges = [MappedKey ((.declaration) finding) | finding <- diffMapped oldSpec newSpec]+        relationChanges = map (.declaration) (diffSemanticImpact oldSnapshot newSnapshot)+     in mappedImpactForDeclarations (declarationChanges <> relationChanges) oldSnapshot newSnapshot+  _ -> []+  where+    oldSpec = checkedSpec oldService+    newSpec = checkedSpec newService++mappedFindingChanges :: MappedFinding -> [Change]+mappedFindingChanges finding+  | (.code) finding == MappedDeclAdded = [mappedDeclarationChange LabelAdditive finding]+  | (.code) finding `elem` [MappedHaskellSourceChanged, MappedRecordConstructorChanged, MappedFixturesChanged, GeneratedHaskellNameChanged] =+      [mappedBuildChange finding]+  | (.code) finding `elem` [MappedInitialChanged, MappedCanonicalTypeChanged] =+      mappedBuildChange finding : map (mappedUseChange finding) registerPaths+  | null paths = [mappedBuildChange finding]+  | otherwise = map (mappedUseChange finding) paths+  where+    paths = (.usePaths) finding+    registerPaths = [path | path@UsePath {root = RootRegister {}} <- paths]++mappedBuildChange :: MappedFinding -> Change+mappedBuildChange finding =+  mappedChange context ((.declaration) finding) "mapped-build" subject finding+  where+    subject = declarationSubject finding+    renderedPaths = map (\path -> renderMappedSubject path ((.leaf) finding)) ((.usePaths) finding)+    context = (consumerBuildContext ((.declaration) finding) renderedPaths) {contextOriginalLabel = LabelAdvisory}++mappedDeclarationChange :: Label -> MappedFinding -> Change+mappedDeclarationChange label finding =+  mappedChange context ((.declaration) finding) "mapped-declaration" (declarationSubject finding) finding+  where+    context = ChangeContext ((.declaration) finding) [] ContextGeneral label++mappedUseChange :: MappedFinding -> UsePath -> Change+mappedUseChange finding path =+  withMappedConsequences (mappedUseConsequences path) (mappedChange context root facet subject finding)+  where+    subject = renderMappedSubject path ((.leaf) finding)+    (root, facet, kind) = case (.root) path of+      RootCommandField aggregate _ _ _ -> (aggregate, "mapped-command", ContextConsumerBuild)+      RootEventField aggregate _ _ _ -> (aggregate, "mapped-event", ContextPrivateEvent)+      RootRegister aggregate _ _ -> (aggregate, "mapped-register", ContextSnapshot)+      RootWorkqueueField workqueue _ _ -> (workqueue, "mapped-workqueue", ContextQueue)+      RootReadModelQueryInput readModel _ -> (readModel, "mapped-query-input", ContextConsumerBuild)+      RootReadModelQueryResult readModel _ -> (readModel, "mapped-query-result", ContextConsumerBuild)+    context = ChangeContext root [subject] kind (mappedContextHint finding kind)++mappedUseConsequences :: UsePath -> Set MappedConsequence+mappedUseConsequences path = Set.fromList $ case (.root) path of+  RootCommandField aggregate _ _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate)]+  RootEventField aggregate _ _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate), MappedPrivateEventHistory aggregate]+  RootRegister aggregate _ _ -> [MappedConsumerBuild (AggregateConsumer aggregate), MappedSnapshotHydration aggregate]+  RootWorkqueueField workqueue _ _ -> [MappedConsumerBuild (WorkqueueConsumer workqueue), MappedWorkqueueHistory workqueue]+  RootReadModelQueryInput readModel _ -> [MappedConsumerBuild (ReadModelQueryConsumer readModel MappedQueryInput), MappedQueryApi readModel MappedQueryInput]+  RootReadModelQueryResult readModel _ -> [MappedConsumerBuild (ReadModelQueryConsumer readModel MappedQueryResult), MappedQueryApi readModel MappedQueryResult]++withMappedConsequences :: Set MappedConsequence -> Change -> Change+withMappedConsequences consequences = \case+  Additive kind -> Additive (replaceMappedConsequences consequences kind)+  Advisory kind -> Advisory (replaceMappedConsequences consequences kind)+  Breaking kind -> Breaking (replaceMappedConsequences consequences kind)++replaceMappedConsequences :: Set MappedConsequence -> ChangeKind -> ChangeKind+replaceMappedConsequences mappedConsequences kind =+  ChangeKind+    { node = kind.node,+      facet = kind.facet,+      subject = kind.subject,+      code = kind.code,+      context = kind.context,+      vector = kind.vector,+      mappedPersistedImpact = kind.mappedPersistedImpact,+      mappedConsequences,+      paths = kind.paths,+      detail = kind.detail+    }++mappedContextHint :: MappedFinding -> ContextKind -> Label+mappedContextHint finding kind = case kind of+  ContextSnapshot -> LabelAdvisory+  ContextQueue -> LabelBreaking+  ContextConsumerBuild -> LabelAdvisory+  ContextPrivateEvent+    | (.code) finding == MappedFieldAddedWithDefault -> case (.oldUnknownFields) finding of+        Just IgnoreUnknown -> LabelAdditive+        _ -> LabelBreaking+    | (.code) finding `elem` [MappedArmAdded, MappedEnumValueAdded] -> LabelAdvisory+    | (.code) finding `elem` [MappedBindingChanged, MappedInitialChanged, MappedCanonicalTypeChanged] -> LabelAdvisory+    | otherwise -> LabelBreaking+  _ -> LabelAdvisory++mappedChange :: ChangeContext -> Name -> Text -> Text -> MappedFinding -> Change+mappedChange context node facet subject finding =+  mkChange label context node facet subject ((.code) finding) renderedDetail+  where+    label = deriveLabel defaultGate (classifyCompatibility context ((.code) finding))+    renderedDetail = case (.contextKind) context of+      ContextQueue ->+        (.detail) finding+          <> "; queued jobs remain schema-version-1 history; drain the queue or supply an application-owned transitional codec before deployment"+      _ -> (.detail) finding++declarationSubject :: MappedFinding -> Text+declarationSubject finding =+  (.declaration) finding <> if T.null ((.leaf) finding) then "" else " " <> (.leaf) finding++nodeAggregate :: Node -> Maybe Aggregate+nodeAggregate (NAggregate a) = Just a+nodeAggregate _ = Nothing++nodeProcess :: Node -> Maybe ProcessNode+nodeProcess (NProcess process) = Just process+nodeProcess _ = Nothing++nodeRouter :: Node -> Maybe RouterNode+nodeRouter (NRouter router) = Just router+nodeRouter _ = Nothing++nodeContract :: Node -> Maybe ContractNode+nodeContract (NContract contract) = Just contract+nodeContract _ = Nothing++nodeIntake :: Node -> Maybe IntakeNode+nodeIntake (NIntake intake) = Just intake+nodeIntake _ = Nothing++nodeEmit :: Node -> Maybe EmitNode+nodeEmit (NEmit emit) = Just emit+nodeEmit _ = Nothing++nodePublisher :: Node -> Maybe PublisherNode+nodePublisher (NPublisher publisher) = Just publisher+nodePublisher _ = Nothing++nodeWorkqueue :: Node -> Maybe WorkqueueNode+nodeWorkqueue (NWorkqueue workqueue) = Just workqueue+nodeWorkqueue _ = Nothing++nodePgmqDispatch :: Node -> Maybe PgmqDispatchNode+nodePgmqDispatch (NPgmqDispatch dispatch) = Just dispatch+nodePgmqDispatch _ = Nothing++nodeReadModel :: Node -> Maybe ReadModelNode+nodeReadModel (NReadModel readModel) = Just readModel+nodeReadModel _ = Nothing++nodeProjectionTarget :: Node -> Maybe ProjectionTargetNode+nodeProjectionTarget (NProjectionTarget target) = Just target+nodeProjectionTarget _ = Nothing++nodeRebuildGroup :: Node -> Maybe RebuildGroupNode+nodeRebuildGroup (NRebuildGroup groupNode) = Just groupNode+nodeRebuildGroup _ = Nothing++nodeProjectionRevision :: Node -> Maybe ProjectionRevisionNode+nodeProjectionRevision (NProjectionRevision revision) = Just revision+nodeProjectionRevision _ = Nothing++nodeExternalRead :: Node -> Maybe ExternalReadNode+nodeExternalRead (NExternalRead externalRead) = Just externalRead+nodeExternalRead _ = Nothing++nodeProjectionOwner :: Node -> Maybe ProjectionOwnerNode+nodeProjectionOwner (NProjectionOwner owner) = Just owner+nodeProjectionOwner _ = Nothing++nodeWorkflow :: Node -> Maybe WorkflowNode+nodeWorkflow (NWorkflow workflow) = Just workflow+nodeWorkflow _ = Nothing++-- | Router identity is replay-sensitive: the stable name and key feed every+-- target-keyed dispatch id, and the target selects the persisted stream family.+routerDiff :: DiffEnv -> [Change]+routerDiff env =+  concatMap (uncurry routerPairDiff) ((.matched) paired)+    ++ [additive ((.id) router) "router" ((.id) router) DeclarationAdded "new router declaration" | router <- (.added) paired]+    ++ [breaking ((.id) router) "router-identity" ((.id) router) RouterStableNameChanged "router removed while replayable source events may still derive target-keyed dispatch ids from its stable identity" | router <- (.removed) paired]+  where+    paired = pairByName nodeRouter (.id) env++routerPairDiff :: RouterNode -> RouterNode -> [Change]+routerPairDiff oldRouter newRouter =+  stableName+    ++ keyDerivation+    ++ target+    ++ routerDecideSurfaceDiff oldRouter newRouter+  where+    nodeName = (.id) newRouter+    stableName =+      [ breaking nodeName "router-stable-name" nodeName RouterStableNameChanged $+          "router stable name changed from '" <> (.name) oldRouter <> "' to '" <> (.name) newRouter <> "'; every deterministicRouterCommandId is re-keyed, so redelivery can duplicate the full resolved fan-out"+      | (.name) oldRouter /= (.name) newRouter+      ]+    keyDerivation =+      [ breaking nodeName "router-key" ((.field) ((.key) newRouter)) DerivedIdentityChanged "router key field or derivation changed; replay derives different target dispatch ids"+      | (.key) oldRouter /= (.key) newRouter+      ]+    target =+      [ breaking nodeName "router-target" ((.target) newRouter) DerivedIdentityChanged "router target aggregate changed; replay addresses a different persisted stream family"+      | (.target) oldRouter /= (.target) newRouter+      ]++routerDecideSurfaceDiff :: RouterNode -> RouterNode -> [Change]+routerDecideSurfaceDiff oldRouter newRouter =+  [ advisory+      ((.id) newRouter)+      "router-decide"+      ((.id) newRouter)+      RouterDecideSurfaceChanged+      "router dispatch surface changed: a source event redelivered across the deploy dispatches under the same deterministic ids, so half-old/half-new fan-out merges silently. Drain or pause the router's subscription and replay or discard dead letters before deploying; see docs/user/deploy-ordering.md. Hole-only decide changes are not visible to diff; the same drain rule applies to those too."+  | oldSurface /= newSurface+  ]+  where+    oldSurface =+      ( renderResolveSurface ((.resolve) oldRouter),+        renderRouterDispatchSurface ((.dispatch) oldRouter)+      )+    newSurface =+      ( renderResolveSurface ((.resolve) newRouter),+        renderRouterDispatchSurface ((.dispatch) newRouter)+      )++readModelDiff :: DiffEnv -> [Change]+readModelDiff env =+  concatMap (uncurry (readModelPairDiff env oldSupplies newSupplies)) ((.matched) paired)+    ++ concatMap addedReadModelDiff ((.added) paired)+    ++ concatMap removedReadModelDiff ((.removed) paired)+  where+    paired = pairByName nodeReadModel (.name) env+    oldSupplies = analyzeProjectionSupplies ((.old) env)+    newSupplies = analyzeProjectionSupplies ((.new) env)++readModelPairDiff :: DiffEnv -> ProjectionSupplyAnalysis -> ProjectionSupplyAnalysis -> ReadModelNode -> ReadModelNode -> [Change]+readModelPairDiff env oldSupplies newSupplies oldReadModel newReadModel =+  versionChanges+    ++ shapeChanges+    ++ identityChanges+    ++ policyChanges+    ++ bindingChanges+    ++ queryContractChanges+  where+    nodeName = (.name) newReadModel+    versionChanges+      | (.version) newReadModel < (.version) oldReadModel =+          [ breaking nodeName "read-model-version" nodeName ReadModelVersionDecreased ("version decreased from " <> tInt ((.version) oldReadModel) <> " to " <> tInt ((.version) newReadModel))+          ]+      | (.version) newReadModel > (.version) oldReadModel =+          [ additive nodeName "read-model-version" nodeName VersionBumped ("version increased from " <> tInt ((.version) oldReadModel) <> " to " <> tInt ((.version) newReadModel) <> "; register and rebuild the new shape before serving it")+          ]+      | otherwise = []+    oldShape = ((.columns) oldReadModel, (.shape) oldReadModel)+    newShape = ((.columns) newReadModel, (.shape) newReadModel)+    shapeChanges =+      [ breaking nodeName "read-model-shape" nodeName ReadModelShapeChangedWithoutBump ("declared columns or captured shape hash changed at version " <> tInt ((.version) newReadModel) <> "; bump version and rebuild")+      | oldShape /= newShape,+        (.version) oldReadModel == (.version) newReadModel+      ]+    oldRegistry = registryNameFor ((.context) ((.old) env)) oldReadModel+    newRegistry = registryNameFor ((.context) ((.new) env)) newReadModel+    oldSubscription = subscriptionNameFor ((.context) ((.old) env)) oldReadModel+    newSubscription = subscriptionNameFor ((.context) ((.new) env)) newReadModel+    identityChanges =+      [ breaking nodeName "read-model-identity" nodeName DerivedIdentityChanged ("registry name changed '" <> oldRegistry <> "' -> '" <> newRegistry <> "'; the old registration row is orphaned")+      | oldRegistry /= newRegistry+      ]+        ++ [ breaking nodeName "read-model-table" nodeName DerivedIdentityChanged ("qualified table changed '" <> qualifiedIdentity oldReadModel <> "' -> '" <> qualifiedIdentity newReadModel <> "'; existing data remains under the old identity")+           | ((.schema) oldReadModel, (.table) oldReadModel) /= ((.schema) newReadModel, (.table) newReadModel)+           ]+        ++ [ breaking nodeName "read-model-subscription" nodeName DerivedIdentityChanged ("subscription changed '" <> oldSubscription <> "' -> '" <> newSubscription <> "'; the worker cursor remains under the old identity")+           | oldSubscription /= newSubscription+           ]+    -- There are three policy comparison shapes: catalog-owned on both sides,+    -- legacy on both sides, or a migration between them. The mixed case uses+    -- the normalized freshness matrix in docs/plans/250-report-legacy-strong-consistency-weakening-across-the-language-4-to-5-migration-in-diff.md;+    -- unlike two catalog-owned revisions, a migration strengthening is additive.+    policyChanges = case ((.supply) oldReadModel, (.supply) newReadModel) of+      (OwnerDerivedSupply, OwnerDerivedSupply) ->+        [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness changed " <> renderFreshness ((.freshness) oldReadModel) <> " -> " <> renderFreshness ((.freshness) newReadModel) <> "; catalog and owning-group query policy identity changed")+        | (.freshness) oldReadModel /= (.freshness) newReadModel+        ]+      (LegacyReadModelSupply {}, LegacyReadModelSupply {}) ->+        legacyFeedChanges <> legacyConsistencyChanges <> legacyScopeChanges+      _ -> migrationFreshnessChanges+    migrationFreshnessChanges = case ((.freshness) oldReadModel, (.freshness) newReadModel) of+      (oldFreshness, newFreshness)+        | oldFreshness == newFreshness -> []+      (FreshnessWaitForHead _, FreshnessImmediate) ->+        [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness weakened " <> renderFreshness ((.freshness) oldReadModel) <> " -> immediate across the legacy consistency migration; callers lose the cursor-wait guarantee")+        ]+      (FreshnessImmediate, FreshnessWaitForHead _) ->+        [ additive nodeName "query-freshness" nodeName CompatibilityStrengthened ("query freshness strengthened immediate -> " <> renderFreshness ((.freshness) newReadModel) <> " across the legacy consistency migration; callers gain a cursor-wait guarantee")+        ]+      (FreshnessWaitForHead oldWaitScope, FreshnessWaitForHead newWaitScope)+        | scopeStrengthened oldWaitScope newWaitScope ->+            [ additive nodeName "query-freshness" nodeName CompatibilityStrengthened ("query freshness head scope widened " <> renderScope oldWaitScope <> " -> " <> renderScope newWaitScope <> " across the legacy consistency migration")+            ]+        | otherwise ->+            [ breaking nodeName "query-freshness" nodeName QueryFreshnessChanged ("query freshness head scope changed " <> renderScope oldWaitScope <> " -> " <> renderScope newWaitScope <> " across the legacy consistency migration; callers no longer wait on the same event surface")+            ]+      (FreshnessImmediate, FreshnessImmediate) -> []+    legacyFeedChanges =+      [ breaking nodeName "read-model-feed" nodeName ReadModelFeedChanged ("feed changed " <> renderFeed oldFeed <> " -> " <> renderFeed newFeed <> "; projection wiring and rebuild identities changed")+      | Just oldFeed <- [legacyReadModelFeed oldReadModel],+        Just newFeed <- [legacyReadModelFeed newReadModel],+        oldFeed /= newFeed+      ]+    legacyConsistencyChanges = case (legacyReadModelConsistency oldReadModel, legacyReadModelConsistency newReadModel) of+      (Just Strong, Just Eventual) ->+        [breaking nodeName "read-model-consistency" nodeName ReadModelConsistencyWeakened "default consistency changed Strong -> Eventual; callers lose the cursor-wait guarantee"]+      (Just Eventual, Just Strong) ->+        [additive nodeName "read-model-consistency" nodeName CompatibilityStrengthened "default consistency changed Eventual -> Strong; callers gain a cursor-wait guarantee"]+      _ -> []+    oldScope = effectiveScope (legacyReadModelScope oldReadModel)+    newScope = effectiveScope (legacyReadModelScope newReadModel)+    legacyScopeChanges+      | oldScope == newScope = []+      | scopeStrengthened oldScope newScope =+          [additive nodeName "read-model-scope" nodeName CompatibilityStrengthened ("Strong scope widened " <> renderScope oldScope <> " -> " <> renderScope newScope)]+      | otherwise =+          [breaking nodeName "read-model-scope" nodeName ReadModelConsistencyWeakened ("Strong scope changed " <> renderScope oldScope <> " -> " <> renderScope newScope <> "; callers no longer wait on the same event surface")]+    bindingChanges =+      [ breaking nodeName "read-model-catalog-binding" nodeName CatalogQueryBindingChanged "query-model rebuild group, observed target set, resolved projection supplier, or backing target changed; persisted lifecycle identity and rebuild completeness changed"+      | bindingIdentity oldSupplies oldReadModel /= bindingIdentity newSupplies newReadModel+      ]+    bindingIdentity supplyAnalysis readModel =+      ( (.group) readModel,+        Set.fromList ((.observedTargets) readModel),+        resolvedSupplier supplyAnalysis readModel,+        effectiveBacking readModel+      )+    resolvedSupplier supplyAnalysis readModel =+      case [ (.projectionOwner) supply+           | supply <- (.resolvedProjectionSupplies) supplyAnalysis,+             (.queryModel) supply == (.name) readModel+           ] of+        [ownerName] -> Just ownerName+        _ -> Nothing+    effectiveBacking readModel = case (.backingTarget) readModel of+      Just target -> Just target+      Nothing -> case (.observedTargets) readModel of+        [single] -> Just single+        _ -> Nothing+    queryContractChanges =+      queryPositionChange+        "input"+        MappedQueryInput+        ReadModelQueryInputChanged+        ((.input) <$> (.queryTypes) oldReadModel)+        ((.input) <$> (.queryTypes) newReadModel)+        "callers"+        <> queryPositionChange+          "result"+          MappedQueryResult+          ReadModelQueryResultChanged+          ((.result) <$> (.queryTypes) oldReadModel)+          ((.result) <$> (.queryTypes) newReadModel)+          "result consumers"+    queryPositionChange position mappedPosition code oldExpression newExpression owner =+      [ withMappedConsequences+          (Set.fromList [MappedConsumerBuild consumer, MappedQueryApi nodeName mappedPosition])+          ( advisoryAt+              (consumerBuildContext nodeName [nodeName <> " query " <> position])+              nodeName+              ("read-model-query-" <> position)+              (nodeName <> " query " <> position)+              code+              ( "query "+                  <> position+                  <> " changed "+                  <> renderMaybeType oldExpression+                  <> " -> "+                  <> renderMaybeType newExpression+                  <> "; recompile "+                  <> owner+                  <> " against the generated QueryContract. SQL columns, projection replay, and persisted history are unaffected"+              )+          )+      | oldExpression /= newExpression+      ]+      where+        consumer = ReadModelQueryConsumer nodeName mappedPosition+    renderMaybeType = maybe "(absent)" renderTypeExpr++projectionTargetDiff :: DiffEnv -> [Change]+projectionTargetDiff env =+  concatMap (uncurry projectionTargetPairDiff) ((.matched) paired)+    <> [additive ((.name) target) "projection-target" ((.name) target) CatalogTargetAdded "new application-owned target; consumer DDL is still required" | target <- (.added) paired]+    <> [breaking ((.name) target) "projection-target" ((.name) target) CatalogTargetRemoved "target declaration removed while table data and rebuild evidence may remain" | target <- (.removed) paired]+  where+    paired = pairByName nodeProjectionTarget (.name) env++projectionTargetPairDiff :: ProjectionTargetNode -> ProjectionTargetNode -> [Change]+projectionTargetPairDiff oldTarget newTarget = locationChange <> resetChange <> dependencyChange+  where+    targetName = (.name) newTarget+    locationChange =+      [ breaking targetName "projection-target-location" targetName CatalogTargetLocationChanged $+          "qualified target changed " <> (.schema) oldTarget <> "." <> (.table) oldTarget <> " -> " <> (.schema) newTarget <> "." <> (.table) newTarget <> "; Keiro does not move application data"+      | ((.schema) oldTarget, (.table) oldTarget) /= ((.schema) newTarget, (.table) newTarget)+      ]+    resetChange = case ((.reset) oldTarget, (.reset) newTarget) of+      (TargetPreserve, TargetClear) -> [breaking targetName "projection-target-reset" targetName CatalogTargetResetPolicyChanged "reset changed preserve -> clear; a rebuild can now delete retained brownfield data"]+      (TargetClear, TargetPreserve) -> [advisory targetName "projection-target-reset" targetName CatalogTargetResetPolicyChanged "reset changed clear -> preserve; application reconciliation must now prove retained rows"]+      _ -> []+    dependencyChange =+      [ breaking targetName "projection-target-dependencies" targetName CatalogTargetDependencyChanged "target dependency order changed; abandon any active fingerprint and start a fresh group rebuild"+      | (.dependsOn) oldTarget /= (.dependsOn) newTarget+      ]++rebuildGroupDiff :: DiffEnv -> [Change]+rebuildGroupDiff env =+  concatMap (uncurry rebuildGroupPairDiff) ((.matched) paired)+    <> [additive ((.name) groupNode) "rebuild-group" ((.name) groupNode) DeclarationAdded "new rebuild group" | groupNode <- (.added) paired]+    <> [breaking ((.name) groupNode) "rebuild-group" ((.name) groupNode) CatalogGroupChanged "rebuild group removed while lifecycle and run evidence may remain" | groupNode <- (.removed) paired]+  where+    paired = pairByName nodeRebuildGroup (.name) env++rebuildGroupPairDiff :: RebuildGroupNode -> RebuildGroupNode -> [Change]+rebuildGroupPairDiff oldGroup newGroup =+  [ breaking ((.name) newGroup) "rebuild-group-membership-order" ((.name) newGroup) CatalogGroupChanged "target membership or deterministic preparation order changed; abandon any active fingerprint and start a fresh rebuild"+  | ((.targets) oldGroup, (.order) oldGroup) /= ((.targets) newGroup, (.order) newGroup)+  ]++projectionRevisionDiff :: DiffEnv -> [Change]+projectionRevisionDiff env =+  concatMap (uncurry projectionRevisionPairDiff) ((.matched) paired)+    <> [additive ((.name) revision) "projection-revision" ((.name) revision) DeclarationAdded "new projection revision and target-schema contract" | revision <- (.added) paired]+    <> [breaking ((.name) revision) "projection-revision" ((.name) revision) CatalogProjectionRevisionRemoved "projection revision removed while serving, rebuild, or read-contract evidence may still refer to it" | revision <- (.removed) paired]+  where+    paired = pairByName nodeProjectionRevision (.name) env++projectionRevisionPairDiff :: ProjectionRevisionNode -> ProjectionRevisionNode -> [Change]+projectionRevisionPairDiff oldRevision newRevision = groupChange <> schemaChanges <> contractChanges+  where+    revisionName = (.name) newRevision+    oldTargets = Map.fromList [((.target) target, target) | target <- (.targets) oldRevision]+    newTargets = Map.fromList [((.target) target, target) | target <- (.targets) newRevision]+    groupChange =+      [ breaking revisionName "projection-revision-group" revisionName CatalogProjectionRevisionChanged "revision rebuild group changed; persisted revision and generation identity no longer matches"+      | (.group) oldRevision /= (.group) newRevision+      ]+    schemaChanges =+      [ breaking revisionName "target-schema" targetName CatalogTargetSchemaChanged $+          "target schema version changed " <> (.schemaVersion) oldTarget <> " -> " <> (.schemaVersion) newTarget <> "; declare a new projection revision instead of mutating a registered one"+      | (targetName, oldTarget) <- Map.toAscList oldTargets,+        Just newTarget <- [Map.lookup targetName newTargets],+        (.schemaVersion) oldTarget /= (.schemaVersion) newTarget+      ]+    contractChanges =+      [ breaking revisionName "projection-revision-contract" revisionName CatalogProjectionRevisionChanged "target membership, provisioner, expected-shape, validator, or ordered promotion-name contract changed; declare a new revision identity"+      | Map.keysSet oldTargets /= Map.keysSet newTargets+          || any targetContractChanged (Map.toAscList oldTargets)+      ]+    targetContractChanged (targetName, oldTarget) = case Map.lookup targetName newTargets of+      Nothing -> True+      Just newTarget ->+        ( (.provisioner) oldTarget,+          (.provisionerVersion) oldTarget,+          (.expectedShape) oldTarget,+          (.validator) oldTarget,+          (.validatorVersion) oldTarget,+          (.promotionObjects) oldTarget+        )+          /= ( (.provisioner) newTarget,+               (.provisionerVersion) newTarget,+               (.expectedShape) newTarget,+               (.validator) newTarget,+               (.validatorVersion) newTarget,+               (.promotionObjects) newTarget+             )++externalReadDiff :: DiffEnv -> [Change]+externalReadDiff env =+  concatMap (uncurry (externalReadPairDiff env)) ((.matched) paired)+    <> [ additive+           (externalReadNodeIdentity externalRead)+           "external-read-version"+           ((.name) externalRead)+           CatalogExternalReadVersionAdded+           "new external read-contract version; grant execute only after its result type and wrapper are deployed"+       | externalRead <- (.added) paired+       ]+    <> [ breaking+           (externalReadNodeIdentity externalRead)+           "external-read-retirement"+           ((.name) externalRead)+           CatalogExternalReadRetired+           "external read-contract version removed; preview dependencies and retire it explicitly before removing the declaration"+       | externalRead <- (.removed) paired+       ]+  where+    paired = pairByName nodeExternalRead externalReadNodeIdentity env++externalReadPairDiff :: DiffEnv -> ExternalReadNode -> ExternalReadNode -> [Change]+externalReadPairDiff env oldExternalRead newExternalRead =+  immutableChanges <> compatibilityChanges <> shapeChanges <> generationChanges+  where+    subject = externalReadNodeIdentity newExternalRead+    immutableChanges =+      [ breaking subject "external-read-contract" ((.name) newExternalRead) CatalogExternalReadContractChanged "query binding or public result type changed for an existing contract version; publish a new version"+      | ( (.queryModel) oldExternalRead,+          (.resultSchema) oldExternalRead,+          (.resultType) oldExternalRead+        )+          /= ( (.queryModel) newExternalRead,+               (.resultSchema) newExternalRead,+               (.resultType) newExternalRead+             )+      ]+    oldCompatibility = Set.fromList ((.compatibleRevisions) oldExternalRead)+    newCompatibility = Set.fromList ((.compatibleRevisions) newExternalRead)+    compatibilityChanges+      | oldCompatibility == newCompatibility = []+      | oldCompatibility `Set.isSubsetOf` newCompatibility =+          [ additive subject "external-read-compatibility" ((.name) newExternalRead) CatalogExternalReadCompatibilityChanged "compatible projection-revision set widened; deploy the higher surface generation before promoting the added revision"+          ]+      | otherwise =+          [ breaking subject "external-read-compatibility" ((.name) newExternalRead) CatalogExternalReadCompatibilityChanged "compatible projection-revision set narrowed or replaced for an existing contract version"+          ]+    shapeChanges =+      [ breaking subject "external-read-result-shape" ((.name) newExternalRead) CatalogExternalReadResultShapeChanged "checked query result shape changed for an existing contract version; restore compatibility or publish a new version"+      | externalReadShape ((.old) env) oldExternalRead /= externalReadShape ((.new) env) newExternalRead+      ]+    generationChanges+      | (.surfaceGeneration) oldExternalRead == (.surfaceGeneration) newExternalRead = []+      | (.surfaceGeneration) oldExternalRead < (.surfaceGeneration) newExternalRead =+          [ advisory subject "external-read-surface-generation" ((.name) newExternalRead) CatalogExternalReadContractChanged "surface generation increased; roll out the newer declaration before older processes can reconcile"+          ]+      | otherwise =+          [ breaking subject "external-read-surface-generation" ((.name) newExternalRead) CatalogExternalReadContractChanged "surface generation decreased; runtime reconciliation refuses this downgrade"+          ]+    externalReadShape spec externalRead = case [(.shape) readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.queryModel) externalRead] of+      shape : _ -> Just shape+      [] -> Nothing++projectionOwnerDiff :: DiffEnv -> [Change]+projectionOwnerDiff env =+  concatMap (uncurry projectionOwnerPairDiff) ((.matched) paired)+    <> [additive ((.name) owner) "projection-owner" ((.name) owner) DeclarationAdded "new projection owner" | owner <- (.added) paired]+    <> [breaking ((.name) owner) "projection-owner" ((.name) owner) CatalogOwnerRemoved "projection owner removed while targets and replay evidence remain" | owner <- (.removed) paired]+  where+    paired = pairByName nodeProjectionOwner (.name) env++projectionOwnerPairDiff :: ProjectionOwnerNode -> ProjectionOwnerNode -> [Change]+projectionOwnerPairDiff oldOwner newOwner = groupAndTargets <> orderChange <> sourceChange <> feedIdentityChange <> checkpointPolicyChange <> replayChange+  where+    ownerName = (.name) newOwner+    groupAndTargets =+      [ breaking ownerName "projection-owner-group-targets" ownerName CatalogOwnerChanged "rebuild group or owned target set changed"+      | ((.group) oldOwner, Set.fromList ((.targets) oldOwner)) /= ((.group) newOwner, Set.fromList ((.targets) newOwner))+      ]+    orderChange =+      [ advisory ownerName "projection-owner-order" ownerName CatalogHandlerOrderChanged "handler order changed; replay materialization and resume fingerprint change"+      | (.order) oldOwner /= (.order) newOwner+      ]+    sourceChange =+      [ breaking ownerName "projection-owner-sources" ownerName CatalogSourceChanged "source selection changed; historical coverage and active resume fingerprint change"+      | (.sources) oldOwner /= (.sources) newOwner+      ]+    feedIdentityChange =+      [ breaking ownerName "projection-delivery" ownerName ProjectionDeliveryChanged "projection delivery changed; handler lifecycle, cursor, and dedup identity require coordinated review"+      | (.delivery) oldOwner /= (.delivery) newOwner+      ]+        <> [ breaking ownerName "projection-owner-delivery-identity" ownerName CatalogFeedIdentityChanged "subscription or dedup identity changed; cursors or dedup evidence remain under the old identity"+           | ((.subscription) oldOwner, (.dedup) oldOwner) /= ((.subscription) newOwner, (.dedup) newOwner)+           ]+    checkpointPolicyChange =+      [ breaking ownerName "projection-owner-checkpoint-on-missing" ownerName CatalogCheckpointPolicyChanged $+          "checkpoint-on-missing changed " <> renderCheckpointOnMissing oldPolicy <> " -> " <> renderCheckpointOnMissing newPolicy <> "; the generated catalog and next absent-row startup behavior change, while persisted subscription identity and existing checkpoint rows remain unchanged"+      | [oldPolicy] <- [(.checkpointOnMissing) oldOwner],+        [newPolicy] <- [(.checkpointOnMissing) newOwner],+        oldPolicy /= newPolicy+      ]+    replayChange =+      [ breaking ownerName "projection-owner-replay-policy" ownerName CatalogReplayPolicyChanged "replay policy changed; abandon any active run before rebuilding under the new contract"+      | (.replay) oldOwner /= (.replay) newOwner+      ]++renderCheckpointOnMissing :: CheckpointOnMissingNode -> Text+renderCheckpointOnMissing CheckpointFromBeginning = "from-beginning"+renderCheckpointOnMissing CheckpointFromCurrentHead = "from-current-head"+renderCheckpointOnMissing CheckpointFail = "fail"++addedReadModelDiff :: ReadModelNode -> [Change]+addedReadModelDiff readModel =+  [additive ((.name) readModel) "read-model" ((.name) readModel) DeclarationAdded "new read model"]++removedReadModelDiff :: ReadModelNode -> [Change]+removedReadModelDiff readModel =+  [breaking ((.name) readModel) "read-model-identity" ((.name) readModel) DerivedIdentityChanged "read model removed while registered metadata, data, subscription cursors, and callers may remain"]++qualifiedIdentity :: ReadModelNode -> Text+qualifiedIdentity readModel = (.schema) readModel <> "." <> (.table) readModel++renderFeed :: RmFeed -> Text+renderFeed RmInline = "inline"+renderFeed RmSubscription = "subscription"++renderFreshness :: QueryFreshnessNode -> Text+renderFreshness FreshnessImmediate = "immediate"+renderFreshness (FreshnessWaitForHead scope) = "wait-for-head " <> renderScope scope++effectiveScope :: Maybe RmScope -> RmScope+effectiveScope Nothing = RmEntireLog+effectiveScope (Just scope) = scope++scopeStrengthened :: RmScope -> RmScope -> Bool+scopeStrengthened (RmCategory _) RmEntireLog = True+scopeStrengthened _ _ = False++renderScope :: RmScope -> Text+renderScope RmEntireLog = "entire-log"+renderScope (RmCategory categoryName) = "category '" <> categoryName <> "'"++aggregateDiff :: DiffEnv -> [Change]+aggregateDiff env =+  concatMap+    (\(oldAggregate, newAggregate) -> aggregatePairDiff ((.old) env) ((.new) env) oldAggregate newAggregate)+    ((.matched) paired)+    ++ concatMap addedAggregateDiff ((.added) paired)+    ++ concatMap removedAggregateDiff ((.removed) paired)+  where+    paired = pairByName nodeAggregate (.name) env++aggregatePairDiff :: Spec -> Spec -> Aggregate -> Aggregate -> [Change]+aggregatePairDiff oldSpec newSpec oldAgg newAgg =+  commandFieldIdentityDiff oldAgg newAgg+    ++ concatMap (eventDiff oldAgg newAgg) ((.events) newAgg)+    ++ removedEvents oldAgg newAgg+    ++ wireDiff oldAgg newAgg+    ++ projectionDiff oldAgg newAgg+    ++ guardTighteningDiff oldAgg newAgg+    ++ domainOutcomeDiff oldAgg newAgg+    ++ transitionSurfaceDiff oldSpec newSpec oldAgg newAgg++-- | Typed outcomes are forward command behavior, not persisted fold behavior.+-- Pair transitions by their frozen fold canonical form so a reason-only change+-- reports precisely without also claiming replay or snapshot impact.+domainOutcomeDiff :: Aggregate -> Aggregate -> [Change]+domainOutcomeDiff oldAggregate newAggregate = declarationChange ++ transitionChanges+  where+    declarationChange =+      [ advisory+          ((.name) newAggregate)+          "domain-outcome-types"+          ((.name) newAggregate)+          DomainOutcomeTypesChanged+          ( "domain outcome types changed from '"+              <> renderDeclaration ((.domainOutcomeTypes) oldAggregate)+              <> "' to '"+              <> renderDeclaration ((.domainOutcomeTypes) newAggregate)+              <> "'; generated command result types and callers must be updated, while event history and snapshots remain compatible"+          )+      | canonicalDomainOutcomeTypes ((.domainOutcomeTypes) oldAggregate)+          /= canonicalDomainOutcomeTypes ((.domainOutcomeTypes) newAggregate)+      ]+    transitionChanges =+      [ advisory+          ((.name) newAggregate)+          "transition-domain-outcome"+          (transitionSubject ordinal newTransition)+          DomainTransitionOutcomeChanged+          ( "domain outcome changed from '"+              <> canonicalTransitionOutcome ((.outcome) oldTransition)+              <> "' to '"+              <> canonicalTransitionOutcome ((.outcome) newTransition)+              <> "'; forward command behavior changes, while the selected edge, emitted events, fold, replay, and snapshots remain unchanged"+          )+      | (ordinal, newTransition) <- zip [0 :: Int ..] ((.transitions) newAggregate),+        Just oldTransition <- [find ((== canonicalTransition newTransition) . canonicalTransition) ((.transitions) oldAggregate)],+        canonicalTransitionOutcome ((.outcome) oldTransition) /= canonicalTransitionOutcome ((.outcome) newTransition)+      ]+    renderDeclaration declaration = case canonicalDomainOutcomeTypes declaration of+      "" -> "(disabled)"+      value -> value+    transitionSubject ordinal transition =+      (.source) transition <> " -- " <> (.command) transition <> " [edge " <> T.pack (show ordinal) <> "]"++-- | Report replay-fold evolution. Regenerated scaffold code carries the new+-- fingerprint and invalidates old snapshots, so this remains advisory.+transitionSurfaceDiff :: Spec -> Spec -> Aggregate -> Aggregate -> [Change]+transitionSurfaceDiff oldSpec newSpec oldAgg newAgg+  | aggregateFoldSurfaceForService (legacyCheckedService oldSpec) oldAgg == aggregateFoldSurfaceForService (legacyCheckedService newSpec) newAgg = []+  | otherwise =+      [ advisory+          ((.name) newAgg)+          "transitions"+          ((.name) newAgg)+          AggFoldSurfaceChanged+          "aggregate fold surface changed: replay now interprets the existing log under the new fold. Old snapshots are invalidated automatically once the regenerated fold fingerprint deploys; if the change is fold-neutral confirm it, otherwise re-scaffold and redeploy, and bump `state-codec version=` for any accompanying Holes-only change."+      ]++-- | Plan 143: guard changes are replay-relevant. Hydration re-inverts each+-- stored event and re-checks the edge guard, so a stored event legally appended+-- under the old guard may no longer satisfy the new one — the next command on+-- any stream containing such an event fails hydration with no inverting edge.+-- The remedy is mechanical, so the tool computes it: the removed region is+-- @old-guard ∧ ¬new-guard@ ('complementExpr' eliminates the negation inside the+-- existing grammar), and the advisory prints a paste-ready replay-only twin+-- carrying that region with the OLD transition's writes\/emits\/goto. Whether+-- history should stay replayable (paste the twin) or be truncated instead is a+-- business decision, so the twin is never auto-applied.+--+-- Detection is conservative: any guard change on a paired live (source,+-- command) transition where the new spec declares a guard and does not already+-- contain a replay-only twin for the pair. A pure loosening also matches; the+-- advisory says how to confirm no stored data is affected (the replay audit,+-- docs/plans/142) rather than guessing.+guardTighteningDiff :: Aggregate -> Aggregate -> [Change]+guardTighteningDiff oldAgg newAgg =+  [ advisory ((.name) newAgg) "transition" subject AggGuardTightened detail+  | newT <- (.transitions) newAgg,+    (.mode) newT == TmLive,+    Just oldT <-+      [ find+          (\o -> (.source) o == (.source) newT && (.command) o == (.command) newT && (.mode) o == TmLive)+          ((.transitions) oldAgg)+      ],+    (.guard) newT /= (.guard) oldT,+    Just newGuard <- [(.guard) newT],+    not (hasReplayOnlyTwin newT),+    let subject = (.source) newT <> " -- " <> (.command) newT,+    let removedRegion =+          maybe (complementExpr newGuard) (\o -> EAnd o (complementExpr newGuard)) ((.guard) oldT),+    let twin = replaceTransitionGuardAndMode (Just removedRegion) TmReplayOnly oldT,+    let detail =+          "guard changed on "+            <> subject+            <> ". Stored events appended under the old guard may no longer invert: "+            <> "the next command on any stream containing one fails hydration with "+            <> "no inverting edge. Either confirm via the replay audit that no stored "+            <> "stream exercises the removed region, or keep history replayable by "+            <> "adding the computed replay-only twin (the removed region with the old "+            <> "transition's writes/emits/goto):\n\n"+            <> renderTransition twin+  ]+  where+    hasReplayOnlyTwin newT =+      any+        (\t -> (.mode) t == TmReplayOnly && (.source) t == (.source) newT && (.command) t == (.command) newT)+        ((.transitions) newAgg)++replaceTransitionGuardAndMode :: Maybe Expr -> TransitionMode -> Transition -> Transition+replaceTransitionGuardAndMode guard mode transition =+  Transition+    { source = transition.source,+      command = transition.command,+      implementation = transition.implementation,+      guard,+      writes = transition.writes,+      emits = transition.emits,+      outcome = transition.outcome,+      outcomeDuplicateLocs = transition.outcomeDuplicateLocs,+      goto = transition.goto,+      mode,+      loc = transition.loc+    }++addedAggregateDiff :: Aggregate -> [Change]+addedAggregateDiff newAgg =+  [ additive ((.name) newAgg) "event" ((.name) e) DeclarationAdded "new event type (new aggregate)"+  | e <- (.events) newAgg+  ]++removedAggregateDiff :: Aggregate -> [Change]+removedAggregateDiff oldAgg =+  [ breaking ((.name) oldAgg) "event" ((.name) e) EvtRemovedNotDeprecated "aggregate removed; its event tags are no longer decodable"+  | e <- (.events) oldAgg+  ]++-- | Per-event classification for an event present in the new aggregate.+eventDiff :: Aggregate -> Aggregate -> Event -> [Change]+eventDiff oldAgg newAgg e =+  case find ((== (.name) e) . (.name)) ((.events) oldAgg) of+    Nothing ->+      [additive ((.name) newAgg) "event" ((.name) e) DeclarationAdded "new event type"]+    Just oldE+      | (.version) e > (.version) oldE ->+          selectorChanges oldE+            ++ if (.version) e == (.version) oldE + 1 && (.upcastFrom) e `hasSource` (.version) oldE+              then+                [additive ((.name) newAgg) "event" ((.name) e) VersionBumped ("new version v" <> tInt ((.version) e) <> " with upcaster from v" <> tInt ((.version) oldE))]+                  ++ [ breaking+                         ((.name) newAgg)+                         "event"+                         ((.name) e)+                         UpcasterChainGap+                         ( "bumping v"+                             <> tInt ((.version) oldE)+                             <> " to v"+                             <> tInt ((.version) e)+                             <> " replaced the 'upcast from v"+                             <> tInt vanishedSource+                             <> "' rung; stored v"+                             <> tInt vanishedSource+                             <> " payloads can no longer decode"+                         )+                     | Just (vanishedSource, _) <- [(.upcastFrom) oldE],+                       not (aggregateHasUpcasterSource newAgg vanishedSource)+                     ]+              else+                [ breaking+                    ((.name) newAgg)+                    "event"+                    ((.name) e)+                    EvtVersionMissingUpcaster+                    ( "version changed from v"+                        <> tInt ((.version) oldE)+                        <> " to v"+                        <> tInt ((.version) e)+                        <> " without the required contiguous upcaster from v"+                        <> tInt ((.version) oldE)+                    )+                ]+      | (.version) e < (.version) oldE ->+          selectorChanges oldE+            ++ [breaking ((.name) newAgg) "event" ((.name) e) EvtVersionDecreased ("version decreased from v" <> tInt ((.version) oldE) <> " to v" <> tInt ((.version) e))]+      | otherwise ->+          selectorChanges oldE ++ sameVersionEventDiff oldAgg newAgg oldE e+  where+    selectorChanges oldEvent = eventFieldSelectorChanges oldAgg newAgg oldEvent e++-- | Events present in the old aggregate but absent in the new one. Removing a+-- tag entirely is breaking; deprecation preserves decoding but needs a retained+-- replay-only emitter to preserve replay.+removedEvents :: Aggregate -> Aggregate -> [Change]+removedEvents oldAgg newAgg =+  [ breaking ((.name) newAgg) "event" ((.name) oldE) EvtRemovedNotDeprecated "event removed entirely; its stored payloads can neither decode nor replay. Deprecating instead restores decode-ability only — replay still fails on live streams unless an equivalent replay-only emitting transition is retained; truncate or terminalize affected streams before deleting it"+  | oldE <- (.events) oldAgg,+    isNothing (find ((== (.name) oldE) . (.name)) ((.events) newAgg))+  ]++hasSource :: Maybe (Int, Hole) -> Int -> Bool+hasSource (Just (m, _)) n = m == n+hasSource Nothing _ = False++aggregateHasUpcasterSource :: Aggregate -> Int -> Bool+aggregateHasUpcasterSource aggregate source =+  any ((== Just source) . fmap fst . (.upcastFrom)) ((.events) aggregate)++hasReplayOnlyEmitter :: Aggregate -> Name -> Bool+hasReplayOnlyEmitter aggregate eventName =+  any+    (\transition -> (.mode) transition == TmReplayOnly && eventName `elem` (.emits) transition)+    ((.transitions) aggregate)++data EventFieldSig = EventFieldSig+  { dslName :: !Name,+    selector :: !Name,+    wireKey :: !Text,+    valueType :: !(Maybe TypeExpr)+  }+  deriving stock (Eq, Show)++eventFieldSigs :: Aggregate -> Event -> [EventFieldSig]+eventFieldSigs agg e = case (.body) e of+  EventFields fs -> map fieldSig fs+  EventFromCommand cn ->+    maybe [] (map fieldSig . (.fields)) (find ((== cn) . (.name)) ((.commands) agg))+  where+    fieldSig field =+      let identity = resolveAggregateFieldIdentity field+       in EventFieldSig+            { dslName = (.dslName) identity,+              selector = (.selector) identity,+              wireKey = (.wireKey) identity,+              valueType = (.valueType) field+            }++eventFieldSelectorChanges :: Aggregate -> Aggregate -> Event -> Event -> [Change]+eventFieldSelectorChanges oldAggregate newAggregate oldEvent newEvent =+  [ fieldSelectorChange+      ((.name) newAggregate)+      "event-field-selector"+      ((.name) newEvent <> "." <> (.dslName) newField)+      ((.selector) oldField)+      ((.selector) newField)+      "event field selector"+  | newField <- eventFieldSigs newAggregate newEvent,+    Just oldField <- [find ((== (.dslName) newField) . (.dslName)) (eventFieldSigs oldAggregate oldEvent)],+    (.selector) oldField /= (.selector) newField+  ]++commandFieldIdentityDiff :: Aggregate -> Aggregate -> [Change]+commandFieldIdentityDiff oldAggregate newAggregate =+  [ fieldSelectorChange+      ((.name) newAggregate)+      "command-field-selector"+      ((.name) newCommand <> "." <> (.name) newField)+      ((.selector) (resolveAggregateFieldIdentity oldField))+      ((.selector) (resolveAggregateFieldIdentity newField))+      "command field selector"+  | newCommand <- (.commands) newAggregate,+    Just oldCommand <- [find ((== (.name) newCommand) . (.name)) ((.commands) oldAggregate)],+    newField <- (.fields) newCommand,+    Just oldField <- [find ((== (.name) newField) . (.name)) ((.fields) oldCommand)],+    (.selector) (resolveAggregateFieldIdentity oldField)+      /= (.selector) (resolveAggregateFieldIdentity newField)+  ]++sameVersionEventDiff :: Aggregate -> Aggregate -> Event -> Event -> [Change]+sameVersionEventDiff oldAgg newAgg oldE newE =+  addedChanges+    ++ removedChanges+    ++ typeChanges+    ++ wireKeyChanges+    ++ deprecationChanges+    ++ retirementChanges+  where+    oldFields = eventFieldSigs oldAgg oldE+    newFields = eventFieldSigs newAgg newE+    oldNames = map (.dslName) oldFields+    newNames = map (.dslName) newFields+    added = newNames \\ oldNames+    removed = oldNames \\ newNames+    changed =+      [ ((.dslName) oldField, (.valueType) oldField, (.valueType) newField)+      | oldField <- oldFields,+        Just newField <- [find ((== (.dslName) oldField) . (.dslName)) newFields],+        (.valueType) oldField /= (.valueType) newField+      ]+    addedChanges =+      [ breaking ((.name) newAgg) "event" ((.name) newE) EvtFieldAddedWithoutBump ("field(s) " <> commas added <> " added at the same version v" <> tInt ((.version) newE) <> " without a version bump or upcaster")+      | not (null added)+      ]+    removedChanges =+      [ breaking ((.name) newAgg) "event" ((.name) newE) EvtFieldRemovedSameVersion ("field(s) " <> commas removed <> " removed at the same version v" <> tInt ((.version) newE))+      | not (null removed)+      ]+    typeChanges =+      [ breaking+          ((.name) newAgg)+          "event-field"+          ((.name) newE <> "." <> field)+          EvtFieldTypeChanged+          ("type changed " <> renderAggregateFieldType oldType <> " -> " <> renderAggregateFieldType newType <> " at the same version v" <> tInt ((.version) newE))+      | (field, oldType, newType) <- changed+      ]+    wireKeyChanges =+      [ breaking+          ((.name) newAgg)+          "event-field-wire-key"+          ((.name) newE <> "." <> (.dslName) newField)+          EvtFieldWireKeyChanged+          ( "wire key changed '"+              <> (.wireKey) oldField+              <> "' -> '"+              <> (.wireKey) newField+              <> "'; restore the old key, or version the event and retain an upcaster"+          )+      | newField <- newFields,+        Just oldField <- [find ((== (.dslName) newField) . (.dslName)) oldFields],+        (.wireKey) oldField /= (.wireKey) newField+      ]+    deprecationChanges+      | not ((.deprecated) oldE) && (.deprecated) newE =+          [ if hasReplayOnlyEmitter newAgg ((.name) newE)+              then+                advisory+                  ((.name) newAgg)+                  "event"+                  ((.name) newE)+                  EventRetirementInProgress+                  "event deprecated and removed from the live write path, while an equivalent replay-only transition preserves hydration. Retain that transition until every affected stream is terminal, truncated, or passes the replay audit"+              else+                advisory+                  ((.name) newAgg)+                  "event"+                  ((.name) newE)+                  DeprecatedEventReplayHazard+                  ( "event deprecated: old payloads remain decodable but are no longer replayable — hydration of live streams containing them fails at the first command (HydrationNoInvertingEdge). Add an equivalent replay-only emitting transition or confirm every affected stream is terminal or truncated before deploying"+                      <> if (.retiring) oldE then "" else "; consider a 'retiring event' stage first"+                  )+          ]+      | (.deprecated) oldE && not ((.deprecated) newE) && not ((.retiring) newE) =+          [advisory ((.name) newAgg) "event" ((.name) newE) EventUndeprecated "event returned to the write surface; old payloads remain decodable but new writes resume"]+      | otherwise = []+    retirementChanges+      | not ((.retiring) oldE) && (.retiring) newE =+          [advisory ((.name) newAgg) "event" ((.name) newE) EventRetirementInProgress "retirement started; keep the live emitting transition until affected streams are terminal or truncated, then cut over to deprecated plus an equivalent replay-only emitting transition"]+      | (.retiring) oldE && not ((.retiring) newE) && not ((.deprecated) newE) =+          [additive ((.name) newAgg) "event" ((.name) newE) EventRetirementAbandoned "event retirement abandoned; ordinary live writes continue"]+      | otherwise = []++renderAggregateFieldType :: Maybe TypeExpr -> Text+renderAggregateFieldType Nothing = "(declared)"+renderAggregateFieldType (Just expression) = typeExprCanonicalName expression++renderFieldType :: Maybe Name -> Text+renderFieldType Nothing = "(declared)"+renderFieldType (Just name) = name++wireDiff :: Aggregate -> Aggregate -> [Change]+wireDiff oldAgg newAgg+  | effectiveWire ((.wire) oldAgg) == effectiveWire ((.wire) newAgg) = []+  | otherwise =+      [ breaking+          ((.name) newAgg)+          "wire"+          ((.name) newAgg)+          WireSpecChanged+          ("effective wire convention changed " <> renderWire (effectiveWire ((.wire) oldAgg)) <> " -> " <> renderWire (effectiveWire ((.wire) newAgg)))+      ]++effectiveWire :: Maybe WireSpec -> (Text, Text)+effectiveWire Nothing = ("ctorName", "camelCase")+effectiveWire (Just w) = ((.kind) w, (.fields) w)++renderWire :: (Text, Text) -> Text+renderWire (kindName, fieldNames) = "kind=" <> kindName <> ", fields=" <> fieldNames++projectionDiff :: Aggregate -> Aggregate -> [Change]+projectionDiff oldAggregate newAggregate+  | projectionSurface ((.projection) oldAggregate) == projectionSurface ((.projection) newAggregate) = []+  | otherwise =+      [ advisory+          ((.name) newAggregate)+          "projection"+          ((.name) newAggregate)+          ProjectionChanged+          "projection table, consistency, key, or status mapping changed; coordinate the read-model migration"+      ]++projectionSurface :: Maybe ProjectionSpec -> Maybe (Name, Maybe Consistency, Name, Maybe Mapping)+projectionSurface projection = do+  value <- projection+  pure ((.table) value, (.consistency) value, (.key) value, (.statusMap) value)++idDiff :: DiffEnv -> [Change]+idDiff env =+  concatMap (uncurry (idPairDiff ((.old) env))) ((.matched) paired)+    ++ concatMap addedIdDiff ((.added) paired)+    ++ concatMap removedIdDiff ((.removed) paired)+  where+    paired = pairDeclarations (.name) ((.ids) ((.old) env)) ((.ids) ((.new) env))++idPairDiff :: Spec -> IdDecl -> IdDecl -> [Change]+idPairDiff oldSpec oldId newId =+  [ breaking ((.name) newId) "id-prefix" ((.name) newId) IdPrefixChanged ("prefix changed '" <> (.prefix) oldId <> "' -> '" <> (.prefix) newId <> "'; stored and newly minted ids no longer share an identity domain")+  | (.prefix) oldId /= (.prefix) newId+  ]+    <> nominalBindingDeclDiff oldSpec "id" ((.name) newId) ((.binding) oldId) ((.binding) newId)+    <> [ nominalUseChange+           use+           NominalIdDecoderTightened+           "adopting a checked KindID binding tightens historical decoding; keep a committed valid old-payload fixture and run the targeted real-log audit for this event"+       | (.binding) oldId == Nothing,+         isJust ((.binding) newId),+         use@NominalEventUse {} <- nominalUses oldSpec ((.name) oldId)+       ]++addedIdDiff :: IdDecl -> [Change]+addedIdDiff declaration = [additive ((.name) declaration) "id-prefix" ((.name) declaration) DeclarationAdded "new id declaration"]++removedIdDiff :: IdDecl -> [Change]+removedIdDiff declaration = [breaking ((.name) declaration) "id-prefix" ((.name) declaration) IdPrefixChanged "id declaration removed; persisted ids still use its prefix"]++enumDiff :: DiffEnv -> [Change]+enumDiff env =+  concatMap (uncurry (enumPairDiff ((.old) env))) ((.matched) paired)+    ++ concatMap addedEnumDiff ((.added) paired)+    ++ concatMap (removedEnumDiff ((.old) env)) ((.removed) paired)+  where+    paired = pairDeclarations (.name) ((.enums) ((.old) env)) ((.enums) ((.new) env))++enumPairDiff :: Spec -> EnumDecl -> EnumDecl -> [Change]+enumPairDiff oldSpec oldEnum newEnum =+  [ breaking ((.name) newEnum) "enum-constructor" ctor EnumCtorRemoved ("constructor removed; stored wire value '" <> wire <> "' no longer decodes" <> enumUsageSuffix oldSpec ((.name) oldEnum))+  | (ctor, wire) <- (.ctors) oldEnum,+    isNothing (lookup ctor ((.ctors) newEnum))+  ]+    ++ [ breaking ((.name) newEnum) "enum-constructor" ctor EnumWireSpellingChanged ("wire spelling changed '" <> oldWire <> "' -> '" <> newWire <> "'; stored values using the old spelling no longer decode" <> enumUsageSuffix oldSpec ((.name) oldEnum))+       | (ctor, oldWire) <- (.ctors) oldEnum,+         Just newWire <- [lookup ctor ((.ctors) newEnum)],+         oldWire /= newWire+       ]+    ++ concat+      [ enumAdditionDiff oldSpec newEnum ctor wire+      | (ctor, wire) <- (.ctors) newEnum,+        isNothing (lookup ctor ((.ctors) oldEnum))+      ]+      <> nominalBindingDeclDiff oldSpec "enum" ((.name) newEnum) ((.binding) oldEnum) ((.binding) newEnum)++nominalScalarDiff :: DiffEnv -> [Change]+nominalScalarDiff env =+  concatMap (uncurry scalarPairDiff) ((.matched) paired)+    <> [nominalDeclarationChange ((.name) declaration) DeclarationAdded "new nominal scalar declaration" | declaration <- (.added) paired]+    <> [nominalDeclarationChange ((.name) declaration) NominalRepresentationChanged "nominal scalar declaration removed while persisted uses may remain" | declaration <- (.removed) paired]+  where+    paired = pairDeclarations (.name) ((.nominalScalars) ((.old) env)) ((.nominalScalars) ((.new) env))+    scalarPairDiff oldDeclaration newDeclaration =+      [ nominalDeclarationChange+          ((.name) newDeclaration)+          NominalRepresentationChanged+          ( "nominal scalar representation changed '"+              <> (.representation) oldDeclaration+              <> "' -> '"+              <> (.representation) newDeclaration+              <> "'"+          )+      | (.representation) oldDeclaration /= (.representation) newDeclaration+      ]+        <> nominalBindingDeclDiff+          ((.old) env)+          "scalar"+          ((.name) newDeclaration)+          (Just ((.binding) oldDeclaration))+          (Just ((.binding) newDeclaration))++data NominalUse+  = NominalCommandUse !Name !Name !Name+  | NominalEventUse !Name !Name !Name+  | NominalRegisterUse !Name !Name++nominalUses :: Spec -> Name -> [NominalUse]+nominalUses spec target = concatMap usesInAggregate [aggregate | NAggregate aggregate <- (.nodes) spec]+  where+    usesInAggregate aggregate =+      [ NominalCommandUse ((.name) aggregate) ((.name) command) ((.name) field)+      | command <- (.commands) aggregate,+        field <- (.fields) command,+        fieldReferences target field+      ]+        <> [ NominalEventUse ((.name) aggregate) ((.name) event) ((.name) field)+           | event <- (.events) aggregate,+             field <- eventFields aggregate event,+             fieldReferences target field+           ]+        <> [ NominalRegisterUse ((.name) aggregate) ((.name) register)+           | register <- (.regs) aggregate,+             (.valueType) register == TRef target+           ]+    eventFields aggregate event = case (.body) event of+      EventFields fields -> fields+      EventFromCommand commandName -> concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName]+    fieldReferences targetName field = case (.valueType) field of+      Just (TRef typeName) -> typeName == targetName+      Just _ -> False+      Nothing -> pascalName ((.name) field) == targetName+    pascalName value = case T.uncons value of+      Nothing -> value+      Just (initialChar, rest) -> T.cons (toUpper initialChar) rest++nominalBindingDeclDiff :: Spec -> Text -> Name -> Maybe NominalBindingDecl -> Maybe NominalBindingDecl -> [Change]+nominalBindingDeclDiff oldSpec category name oldBinding newBinding =+  concat+    [ nominalFinding NominalBindingChanged "binding source, symbol, or version changed; rebuild every consumer use and audit persisted event uses because hand-written conversion behavior is opaque"+    | bindingRuntimeFacts oldBinding /= bindingRuntimeFacts newBinding+    ]+    <> concat+      [ nominalFinding NominalFixturesChanged "fixture symbol changed; rerun nominal conformance without claiming runtime wire behavior changed"+      | ((\binding -> binding.fixtures) =<< oldBinding) /= ((\binding -> binding.fixtures) =<< newBinding)+      ]+    <> concat+      [ nominalFinding NominalCanonicalTypeChanged "canonical nominal identity changed; rebuild consumers and invalidate snapshot caches at register uses"+      | ((\binding -> binding.canonicalType) =<< oldBinding) /= ((\binding -> binding.canonicalType) =<< newBinding)+      ]+    <> concat+      [ nominalFinding NominalInitialChanged "consumer-owned initial value symbol changed; rebuild and invalidate snapshot-bearing register streams"+      | ((\binding -> binding.initial) =<< oldBinding) /= ((\binding -> binding.initial) =<< newBinding)+      ]+  where+    bindingRuntimeFacts declaration =+      ( (\binding -> binding.haskell) =<< declaration,+        (\binding -> binding.binding) =<< declaration,+        (\binding -> binding.bindingVersion) =<< declaration+      )+    nominalFinding code detail =+      nominalDeclarationChange name code (category <> " " <> detail)+        : [nominalUseChange use code detail | use <- nominalUses oldSpec name, includeUse code use]+    includeUse NominalFixturesChanged _ = False+    includeUse NominalCanonicalTypeChanged NominalRegisterUse {} = True+    includeUse NominalCanonicalTypeChanged _ = False+    includeUse NominalInitialChanged NominalRegisterUse {} = True+    includeUse NominalInitialChanged _ = False+    includeUse _ NominalCommandUse {} = False+    includeUse _ _ = True++nominalDeclarationChange :: Name -> DiagnosticCode -> Text -> Change+nominalDeclarationChange name code detail =+  mkChange+    (deriveLabel defaultGate vector)+    context+    name+    "nominal-build"+    name+    code+    detail+  where+    context = (consumerBuildContext name [name]) {contextOriginalLabel = LabelAdvisory}+    vector = classifyCompatibility context code++nominalUseChange :: NominalUse -> DiagnosticCode -> Text -> Change+nominalUseChange use code detail =+  mkChange (deriveLabel defaultGate vector) context root facet subject code detail+  where+    (root, facet, subject, kind) = case use of+      NominalCommandUse aggregate command field -> (aggregate, "nominal-command", aggregate <> " command " <> command <> " ." <> field, ContextConsumerBuild)+      NominalEventUse aggregate event field -> (aggregate, "nominal-event", aggregate <> " event " <> event <> " ." <> field, ContextPrivateEvent)+      NominalRegisterUse aggregate register -> (aggregate, "nominal-register", aggregate <> " register " <> register, ContextSnapshot)+    context = ChangeContext root [subject] kind LabelAdvisory+    vector = classifyCompatibility context code++addedEnumDiff :: EnumDecl -> [Change]+addedEnumDiff enumDecl =+  [additive ((.name) enumDecl) "enum-constructor" ctor EnumCtorAdded ("new enum constructor with wire spelling '" <> wire <> "'") | (ctor, wire) <- (.ctors) enumDecl]++enumAdditionDiff :: Spec -> EnumDecl -> Name -> Text -> [Change]+enumAdditionDiff oldSpec enumDecl ctor wire = case enumUsages oldSpec ((.name) enumDecl) of+  [] ->+    [ additive+        ((.name) enumDecl)+        "enum-constructor"+        ctor+        EnumCtorAdded+        ("new constructor with wire spelling '" <> wire <> "'")+    ]+  usages -> map finding usages+  where+    finding usage+      | ".reg." `T.isInfixOf` usage =+          advisoryAt+            (snapshotContext ((.name) enumDecl) [usage])+            ((.name) enumDecl)+            "enum-constructor"+            ctor+            EnumCtorAdded+            ("new constructor with wire spelling '" <> wire <> "' is used by " <> usage <> "; invalidate or rebuild snapshots before values using the new arm hydrate")+      | otherwise =+          advisoryAt+            (privateEventAdditionContext ((.name) enumDecl) [usage])+            ((.name) enumDecl)+            "enum-constructor"+            ctor+            EnumCtorAdded+            ("new constructor with wire spelling '" <> wire <> "' is used by " <> usage <> "; deploy consumers before producers emit the new arm")++removedEnumDiff :: Spec -> EnumDecl -> [Change]+removedEnumDiff oldSpec enumDecl =+  [ breaking ((.name) enumDecl) "enum-constructor" ctor EnumCtorRemoved ("enum removed; stored wire value '" <> wire <> "' no longer decodes" <> enumUsageSuffix oldSpec ((.name) enumDecl))+  | (ctor, wire) <- (.ctors) enumDecl+  ]++enumUsageSuffix :: Spec -> Name -> Text+enumUsageSuffix spec enumType = case enumUsages spec enumType of+  [] -> ""+  usages -> "; used by " <> commas usages++enumUsages :: Spec -> Name -> [Text]+enumUsages spec enumType =+  [(.name) agg <> ".reg." <> (.name) reg | agg <- aggregates, reg <- (.regs) agg, (.valueType) reg == TRef enumType]+    ++ [ (.name) agg <> ".event." <> (.name) event <> "." <> (.dslName) field+       | agg <- aggregates,+         event <- (.events) agg,+         field <- eventFieldSigs agg event,+         Just fieldTypeName <- [(.valueType) field],+         fieldTypeName == TRef enumType+       ]+  where+    aggregates = [agg | NAggregate agg <- (.nodes) spec]++pairDeclarations :: (n -> Name) -> [n] -> [n] -> Paired n+pairDeclarations nameOf oldNodes newNodes =+  Paired+    { matched =+        [ (oldNode, newNode)+        | newNode <- newNodes,+          Just oldNode <- [find ((== nameOf newNode) . nameOf) oldNodes]+        ],+      added = [newNode | newNode <- newNodes, isNothing (find ((== nameOf newNode) . nameOf) oldNodes)],+      removed = [oldNode | oldNode <- oldNodes, isNothing (find ((== nameOf oldNode) . nameOf) newNodes)]+    }++contractDiff :: DiffEnv -> [Change]+contractDiff env =+  concatMap (uncurry contractPairDiff) ((.matched) paired)+    ++ concatMap addedContractDiff ((.added) paired)+    ++ concatMap removedContractDiff ((.removed) paired)+  where+    paired = pairByName nodeContract (.name) env++contractPairDiff :: ContractNode -> ContractNode -> [Change]+contractPairDiff oldContract newContract =+  schemaChanges+    ++ discriminatorChanges+    ++ topicChanges+    ++ concatMap eventPairChanges matchedEvents+    ++ concatMap addedEventChanges addedEvents+    ++ concatMap removedEventChanges removedEvents'+  where+    schemaChanges =+      [ breaking+          ((.name) newContract)+          "schema-version"+          ((.name) newContract)+          ContractSchemaVersionDecreased+          ("schemaVersion decreased from " <> tInt ((.schemaVersion) oldContract) <> " to " <> tInt ((.schemaVersion) newContract))+      | (.schemaVersion) newContract < (.schemaVersion) oldContract+      ]+    discriminatorChanges =+      [ breaking+          ((.name) newContract)+          "discriminator"+          ((.name) newContract)+          ContractDiscriminatorChanged+          ("discriminator changed " <> (.discriminator) oldContract <> " -> " <> (.discriminator) newContract)+      | (.discriminator) oldContract /= (.discriminator) newContract+      ]+    topicChanges = contractTopicDiff oldContract newContract+    eventPairs = pairDeclarations (.name) ((.events) oldContract) ((.events) newContract)+    matchedEvents = (.matched) eventPairs+    addedEvents = (.added) eventPairs+    removedEvents' = (.removed) eventPairs+    eventPairChanges (oldEvent, newEvent) = contractEventDiff oldContract newContract oldEvent newEvent+    addedEventChanges event =+      [additive ((.name) newContract) "contract-event" ((.name) event) ContractEventAdded "new contract event"]+    removedEventChanges event =+      [breaking ((.name) newContract) "contract-event" ((.name) event) ContractEventRemoved "contract event removed; existing cross-service payloads no longer have a declared decoder"]++addedContractDiff :: ContractNode -> [Change]+addedContractDiff contract =+  [additive ((.name) contract) "contract-event" ((.name) event) ContractEventAdded "new event in a new contract" | event <- (.events) contract]++removedContractDiff :: ContractNode -> [Change]+removedContractDiff contract =+  [breaking ((.name) contract) "contract-event" ((.name) event) ContractEventRemoved "contract removed; its cross-service event decoder is no longer declared" | event <- (.events) contract]++contractTopicDiff :: ContractNode -> ContractNode -> [Change]+contractTopicDiff oldContract newContract =+  [ breaking+      ((.name) newContract)+      "contract-topic"+      alias+      ContractTopicChanged+      ("topic alias removed; previous topic was '" <> oldTopic <> "'")+  | (alias, oldTopic) <- (.topics) oldContract,+    isNothing (lookup alias ((.topics) newContract))+  ]+    ++ [ breaking+           ((.name) newContract)+           "contract-topic"+           alias+           ContractTopicChanged+           ("real topic changed '" <> oldTopic <> "' -> '" <> newTopic <> "'")+       | (alias, oldTopic) <- (.topics) oldContract,+         Just newTopic <- [lookup alias ((.topics) newContract)],+         oldTopic /= newTopic+       ]+    ++ [ additive ((.name) newContract) "contract-topic" alias ContractTopicAdded ("new topic alias for '" <> topic <> "'")+       | (alias, topic) <- (.topics) newContract,+         isNothing (lookup alias ((.topics) oldContract))+       ]++contractEventDiff :: ContractNode -> ContractNode -> ContractEvent -> ContractEvent -> [Change]+contractEventDiff oldContract newContract oldEvent newEvent =+  topicAliasChange+    ++ removedFieldChanges+    ++ changedFieldChanges+    ++ selectorFieldChanges+    ++ wireKeyFieldChanges+    ++ addedFieldChanges+  where+    fieldPairs = pairDeclarations (.name) ((.fields) oldEvent) ((.fields) newEvent)+    topicAliasChange =+      [ breaking+          ((.name) newContract)+          "contract-topic"+          ((.name) newEvent)+          ContractTopicChanged+          ("event topic alias changed " <> (.topic) oldEvent <> " -> " <> (.topic) newEvent)+      | (.topic) oldEvent /= (.topic) newEvent+      ]+    removedFieldChanges =+      [ breaking ((.name) newContract) "contract-field" ((.name) newEvent <> "." <> (.name) field) ContractFieldChanged "field removed; existing messages still carry the old contract shape"+      | field <- (.removed) fieldPairs+      ]+    changedFieldChanges =+      [ breaking+          ((.name) newContract)+          "contract-field"+          ((.name) newEvent <> "." <> (.name) newField)+          ContractFieldChanged+          ("field type changed " <> renderContractType ((.valueType) oldField) <> " -> " <> renderContractType ((.valueType) newField))+      | (oldField, newField) <- (.matched) fieldPairs,+        (.valueType) oldField /= (.valueType) newField+      ]+    selectorFieldChanges =+      [ fieldSelectorChange+          ((.name) newContract)+          "contract-field-selector"+          ((.name) newEvent <> "." <> (.name) newField)+          ((.selector) (resolveContractFieldIdentity oldField))+          ((.selector) (resolveContractFieldIdentity newField))+          "contract field selector"+      | (oldField, newField) <- (.matched) fieldPairs,+        (.selector) (resolveContractFieldIdentity oldField)+          /= (.selector) (resolveContractFieldIdentity newField)+      ]+    wireKeyFieldChanges =+      [ breaking+          ((.name) newContract)+          "contract-field"+          ((.name) newEvent <> "." <> (.name) newField)+          ContractFieldChanged+          ( "wire key changed '"+              <> (.wireKey) (resolveContractFieldIdentity oldField)+              <> "' -> '"+              <> (.wireKey) (resolveContractFieldIdentity newField)+              <> "'; restore the old key or revise the public contract with a consumer-first rollout"+          )+      | (oldField, newField) <- (.matched) fieldPairs,+        (.wireKey) (resolveContractFieldIdentity oldField)+          /= (.wireKey) (resolveContractFieldIdentity newField)+      ]+    addedFieldChanges =+      [ if (.schemaVersion) newContract > (.schemaVersion) oldContract+          then advisory ((.name) newContract) "contract-field" subject ContractSchemaVersionBumped ("field added with schemaVersion bump " <> tInt ((.schemaVersion) oldContract) <> " -> " <> tInt ((.schemaVersion) newContract) <> "; coordinate the cross-service rollout")+          else breaking ((.name) newContract) "contract-field" subject ContractFieldChanged "field added without a schemaVersion bump; older in-flight messages do not contain it"+      | field <- (.added) fieldPairs,+        let subject = (.name) newEvent <> "." <> (.name) field+      ]++renderContractType :: ContractType -> Text+renderContractType (CTypeId prefix) = "typeid '" <> prefix <> "'"+renderContractType CText = "text"+renderContractType CInt = "int"++workqueueDiff :: DiffEnv -> [Change]+workqueueDiff env =+  concatMap (uncurry workqueuePairDiff) ((.matched) paired)+    ++ concatMap addedWorkqueueDiff ((.added) paired)+    ++ concatMap removedWorkqueueDiff ((.removed) paired)+  where+    paired = pairWorkqueues env++-- | Prefer source identity, then pair a uniquely renamed queue by its complete+-- explicit runtime identity. This permits a generated module-segment rename to+-- remain a build-only finding without guessing when an external identity is+-- ambiguous.+pairWorkqueues :: DiffEnv -> Paired WorkqueueNode+pairWorkqueues env =+  Paired+    { matched = exact <> fallback,+      added = [queue | queue <- unmatchedNew, queue `notElem` map snd fallback],+      removed = [queue | queue <- unmatchedOld, queue `notElem` map fst fallback]+    }+  where+    oldQueues = mapMaybe nodeWorkqueue ((.nodes) ((.old) env))+    newQueues = mapMaybe nodeWorkqueue ((.nodes) ((.new) env))+    exact =+      [ (oldQueue, newQueue)+      | newQueue <- newQueues,+        Just oldQueue <- [find ((== (.name) newQueue) . (.name)) oldQueues]+      ]+    exactOldNames = map ((.name) . fst) exact+    exactNewNames = map ((.name) . snd) exact+    unmatchedOld = [queue | queue <- oldQueues, (.name) queue `notElem` exactOldNames]+    unmatchedNew = [queue | queue <- newQueues, (.name) queue `notElem` exactNewNames]+    fallback =+      [ (oldQueue, newQueue)+      | newQueue <- unmatchedNew,+        let matchingOld = [queue | queue <- unmatchedOld, queueIdentity queue == queueIdentity newQueue],+        [oldQueue] <- [matchingOld],+        length [queue | queue <- unmatchedNew, queueIdentity queue == queueIdentity newQueue] == 1+      ]++workqueuePairDiff :: WorkqueueNode -> WorkqueueNode -> [Change]+workqueuePairDiff oldQueue newQueue =+  generatedNameChanges+    ++ concatMap pairedFieldDiff ((.matched) fields)+    ++ concatMap addedFieldDiff ((.added) fields)+    ++ concatMap removedFieldDiff ((.removed) fields)+    ++ queueIdentityDiff oldQueue newQueue+    ++ queuePolicyDiff oldQueue newQueue+  where+    generatedNameChanges =+      [ generatedNameChange+          ((.name) newQueue)+          "workqueue-module"+          ((.name) newQueue)+          ((.name) oldQueue)+          ((.name) newQueue)+          "workqueue module segment"+      | (.name) oldQueue /= (.name) newQueue,+        normalizedGeneratedUpper ((.name) oldQueue) /= normalizedGeneratedUpper ((.name) newQueue)+      ]+        ++ [ generatedNameChange+               ((.name) newQueue)+               "workqueue-payload-type"+               ((.payloadName) newQueue)+               ((.payloadName) oldQueue)+               ((.payloadName) newQueue)+               "workqueue payload type"+           | (.payloadName) oldQueue /= (.payloadName) newQueue,+             normalizedGeneratedUpper ((.payloadName) oldQueue) /= normalizedGeneratedUpper ((.payloadName) newQueue)+           ]+    fields = pairDeclarations (.name) ((.payload) oldQueue) ((.payload) newQueue)+    pairedFieldDiff (oldField, newField)+      | (.wire) oldField /= (.wire) newField = [payloadBreaking newField ("wire name changed '" <> (.wire) oldField <> "' -> '" <> (.wire) newField <> "'")]+      | (.valueType) oldField /= (.valueType) newField = [payloadBreaking newField ("type changed " <> renderQueuePayloadType ((.valueType) oldField) <> " -> " <> renderQueuePayloadType ((.valueType) newField))]+      | otherwise = []+    renderQueuePayloadType (LegacyQueueScalar scalar) = queueScalarName scalar+    renderQueuePayloadType (TypedQueueExpression expression) = typeExprCanonicalName expression+    -- Every payload field is required, so adding one always breaks jobs already+    -- queued under the old shape; there is no optional variant to strengthen.+    addedFieldDiff field = [payloadBreaking field "new required field; queued jobs do not contain it"]+    removedFieldDiff field = [payloadBreaking field "field removed; queued jobs still contain the old payload shape"]+    payloadBreaking field detail =+      withMappedConsequences+        (Set.fromList [MappedConsumerBuild consumer, MappedWorkqueueHistory ((.name) newQueue)])+        (breaking ((.name) newQueue) "payload-field" ((.name) field) WqPayloadFieldChanged detail)+      where+        consumer = WorkqueueConsumer ((.name) newQueue)++addedWorkqueueDiff :: WorkqueueNode -> [Change]+addedWorkqueueDiff queue =+  [additive ((.name) queue) "payload-field" ((.name) field) DeclarationAdded "field belongs to a new workqueue payload" | field <- (.payload) queue]++removedWorkqueueDiff :: WorkqueueNode -> [Change]+removedWorkqueueDiff queue =+  [breaking ((.name) queue) "payload-field" ((.name) field) WqPayloadFieldChanged "workqueue removed while persisted jobs may still carry this payload" | field <- (.payload) queue]+    ++ [breaking ((.name) queue) "queue-identity" ((.name) queue) QueueIdentityChanged "workqueue removed; its physical queue, DLQ, and pgmq table may still hold state"]++queueIdentityDiff :: WorkqueueNode -> WorkqueueNode -> [Change]+queueIdentityDiff oldQueue newQueue =+  [ breaking+      ((.name) newQueue)+      "queue-identity"+      ((.name) newQueue)+      QueueIdentityChanged+      "logical, physical, DLQ, or table name changed; queued jobs and dispatch dedupe records remain under the old identity"+  | queueIdentity oldQueue /= queueIdentity newQueue+  ]++queueIdentity :: WorkqueueNode -> (Text, Text, Text, Text)+queueIdentity queue = ((.logical) queue, (.physical) queue, (.dlq) queue, (.table) queue)++generatedNameChange :: Name -> Text -> Text -> Text -> Text -> Text -> Change+generatedNameChange node facet subject oldLogical newLogical occurrenceKind =+  advisory+    node+    facet+    subject+    GeneratedHaskellNameChanged+    ( occurrenceKind+        <> " changed '"+        <> normalizedGeneratedUpper oldLogical+        <> "' -> '"+        <> normalizedGeneratedUpper newLogical+        <> "' while wire, SQL, queue, registry, subscription, and persisted runtime identities remain unchanged; re-scaffold and recompile consumers"+    )++fieldSelectorChange :: Name -> Text -> Text -> Text -> Text -> Text -> Change+fieldSelectorChange node facet subject oldSelector newSelector occurrenceKind =+  advisory+    node+    facet+    subject+    GeneratedHaskellNameChanged+    ( occurrenceKind+        <> " changed '"+        <> oldSelector+        <> "' -> '"+        <> newSelector+        <> "' while DSL and wire identities remain unchanged; re-scaffold and recompile consumers"+    )++normalizedGeneratedUpper :: Text -> Text+normalizedGeneratedUpper logicalName =+  case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of+    Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)+    Left _ -> logicalName+  where+    site =+      HaskellName.NameSite+        { HaskellName.kind = HaskellName.GeneratedTypeSite,+          HaskellName.logicalName = logicalName,+          HaskellName.owner = "diff",+          HaskellName.line = 0+        }++queuePolicyDiff :: WorkqueueNode -> WorkqueueNode -> [Change]+queuePolicyDiff oldQueue newQueue = ordering ++ provision ++ groupKey+  where+    nodeName = (.name) newQueue+    ordering =+      [ breaking nodeName "queue-ordering" nodeName WqOrderingChanged $+          "ordering changed " <> renderWqOrdering ((.ordering) oldQueue) <> " -> " <> renderWqOrdering ((.ordering) newQueue) <> "; consumers were written against the old delivery-order contract"+      | (.ordering) oldQueue /= (.ordering) newQueue+      ]+    provision =+      [ breaking nodeName "queue-provision" nodeName WqProvisionChanged $+          "provision changed " <> renderWqProvision ((.provision) oldQueue) <> " -> " <> renderWqProvision ((.provision) newQueue) <> "; provisioning is create-time only, so migrate the existing queue operationally before changing the spec"+      | (.provision) oldQueue /= (.provision) newQueue+      ]+    groupKey =+      [ breaking nodeName "queue-group-key" nodeName WqGroupKeyChanged $+          "group key derivation changed " <> renderWqGroupKey ((.groupKey) oldQueue) <> " -> " <> renderWqGroupKey ((.groupKey) newQueue) <> "; FIFO messages are re-partitioned across durable ordering groups"+      | (.groupKey) oldQueue /= (.groupKey) newQueue+      ]++renderWqOrdering :: WqOrdering -> Text+renderWqOrdering WqUnordered = "unordered"+renderWqOrdering WqFifoThroughput = "fifo-throughput"+renderWqOrdering WqFifoRoundRobin = "fifo-roundrobin"++renderWqProvision :: WqProvision -> Text+renderWqProvision WqStandard = "standard"+renderWqProvision WqUnlogged = "unlogged"+renderWqProvision (WqPartitioned interval duration) = "partitioned(interval=" <> interval <> ", retention=" <> duration <> ")"++renderWqGroupKey :: Maybe WqGroupKey -> Text+renderWqGroupKey Nothing = "none"+renderWqGroupKey (Just groupKey) =+  (.field) groupKey+    <> " via "+    <> (.via) groupKey+    <> maybe "" (" fixture " <>) ((.fixture) groupKey)++processDiff :: DiffEnv -> [Change]+processDiff env =+  concatMap (uncurry processPairDiff) ((.matched) paired)+    ++ concatMap addedProcessDiff ((.added) paired)+    ++ concatMap removedProcessDiff ((.removed) paired)+  where+    paired = pairByName nodeProcess (.id) env++processPairDiff :: ProcessNode -> ProcessNode -> [Change]+processPairDiff oldProcess newProcess =+  concatMap pairedFieldDiff ((.matched) fields)+    ++ map (fieldChange "field added; source events at the old shape cannot populate it") ((.added) fields)+    ++ map (fieldChange "field removed; the generated process input decoder changed") ((.removed) fields)+    ++ processIdentityDiff oldProcess newProcess+    ++ processTimerWindowDiff oldProcess newProcess+    ++ processDecideSurfaceDiff oldProcess newProcess+    ++ processTimerPayloadDiff oldProcess newProcess+  where+    -- inName is a generated Haskell type name; the wire shape is inFields.+    fields = pairDeclarations (.name) ((.fields) ((.input) oldProcess)) ((.fields) ((.input) newProcess))+    pairedFieldDiff (oldField, newField)+      | (.valueType) oldField /= (.valueType) newField = [fieldChange ("type changed " <> renderFieldType ((.valueType) oldField) <> " -> " <> renderFieldType ((.valueType) newField)) newField]+      | otherwise = []+    fieldChange detail field = breaking ((.id) newProcess) "input-field" ((.name) field) ProcessInputChanged (detail <> "; version the source event before changing process input")++addedProcessDiff :: ProcessNode -> [Change]+addedProcessDiff process =+  [additive ((.id) process) "input-field" ((.name) field) DeclarationAdded "field belongs to a new process input" | field <- (.fields) ((.input) process)]++removedProcessDiff :: ProcessNode -> [Change]+removedProcessDiff process =+  [breaking ((.id) process) "input-field" ((.name) field) ProcessInputChanged "process removed while persisted source events may still require this input decoder" | field <- (.fields) ((.input) process)]+    ++ [breaking ((.id) process) "derived-identity" ((.id) process) DerivedIdentityChanged "process removed while persisted saga, dispatch, and timer identities may still exist"]++processIdentityDiff :: ProcessNode -> ProcessNode -> [Change]+processIdentityDiff oldProcess newProcess =+  [ breaking+      ((.id) newProcess)+      "derived-identity"+      ((.id) newProcess)+      DerivedIdentityChanged+      "process name, correlation derivation, saga stream category, timer id expression, or fired-event-id expression changed; replays and retries no longer derive the persisted identity"+  | processIdentity oldProcess /= processIdentity newProcess+  ]++processIdentity :: ProcessNode -> (Text, Name, Name, Text, Text, Name, Text, Name)+processIdentity process =+  ( (.name) process,+    (.field) ((.correlate) process),+    (.via) ((.correlate) process),+    (.category) ((.saga) process),+    (.prefix) ((.id) ((.timer) process)),+    (.field) ((.id) ((.timer) process)),+    (.prefix) ((.firedEventId) ((.fire) ((.timer) process))),+    (.field) ((.firedEventId) ((.fire) ((.timer) process)))+  )++processTimerWindowDiff :: ProcessNode -> ProcessNode -> [Change]+processTimerWindowDiff oldProcess newProcess =+  [ advisory+      ((.id) newProcess)+      "timer"+      ((.name) ((.timer) newProcess))+      TimerWindowChanged+      ( "fireAt source/window changed "+          <> renderFireAt ((.fireAt) ((.timer) oldProcess))+          <> " -> "+          <> renderFireAt ((.fireAt) ((.timer) newProcess))+          <> "; already-scheduled timers keep their persisted deadline"+      )+  | (.fireAt) ((.timer) oldProcess) /= (.fireAt) ((.timer) newProcess)+  ]++processDecideSurfaceDiff :: ProcessNode -> ProcessNode -> [Change]+processDecideSurfaceDiff oldProcess newProcess =+  [ advisory+      ((.id) newProcess)+      "process-decide"+      ((.id) newProcess)+      ProcessDecideSurfaceChanged+      "process dispatch surface changed: a source event redelivered across the deploy dispatches under the same deterministic ids, so half-old/half-new fan-out merges silently. Drain or pause the process subscription and replay or discard dead letters before deploying; see docs/user/deploy-ordering.md. Hole-only decide changes are not visible to diff; the same drain rule applies to those too."+  | renderHandleSurface ((.handle) oldProcess)+      /= renderHandleSurface ((.handle) newProcess)+  ]++processTimerPayloadDiff :: ProcessNode -> ProcessNode -> [Change]+processTimerPayloadDiff oldProcess newProcess =+  [ advisory+      ((.id) newProcess)+      "timer-payload"+      ((.name) ((.timer) newProcess))+      ProcessTimerPayloadChanged+      "timer payload shape changed: rows scheduled before the deploy carry the old shape, unversioned, and fire under new code — the fire decoder must accept every historically scheduled shape or the timer dead-letters after maxAttempts. Hole-only timer-decoder changes are not visible to diff; the same drain rule applies to those too."+  | renderTimerPayloadSurface ((.timer) oldProcess)+      /= renderTimerPayloadSurface ((.timer) newProcess)+  ]++renderFireAt :: FireAtExpr -> Text+renderFireAt expression = "input." <> (.field) expression <> " + " <> (.window) expression++workflowDiff :: DiffEnv -> [Change]+workflowDiff env =+  concatMap (uncurry workflowPairDiff) ((.matched) paired)+    ++ concatMap addedWorkflowDiff ((.added) paired)+    ++ concatMap removedWorkflowDiff ((.removed) paired)+  where+    paired = pairByName nodeWorkflow (.id) env++workflowPairDiff :: WorkflowNode -> WorkflowNode -> [Change]+workflowPairDiff oldWorkflow newWorkflow =+  inputChanges+    ++ outputChanges+    ++ classifyWorkflowBody oldWorkflow newWorkflow+    ++ workflowIdentityDiff oldWorkflow newWorkflow+  where+    fields = pairDeclarations (.name) ((.inputFields) oldWorkflow) ((.inputFields) newWorkflow)+    inputChanges =+      [workflowShape field "input field added; journaled inputs at the old shape do not contain it" | field <- (.added) fields]+        ++ [workflowShape field "input field removed; journaled inputs still contain the old shape" | field <- (.removed) fields]+        ++ [ workflowShape newField ("input field type changed " <> renderFieldType ((.valueType) oldField) <> " -> " <> renderFieldType ((.valueType) newField))+           | (oldField, newField) <- (.matched) fields,+             (.valueType) oldField /= (.valueType) newField+           ]+    outputChanges =+      [ breaking ((.id) newWorkflow) "workflow-output" ((.output) newWorkflow) WorkflowShapeChanged ("output type changed " <> (.output) oldWorkflow <> " -> " <> (.output) newWorkflow <> "; persisted outcomes may no longer decode")+      | (.output) oldWorkflow /= (.output) newWorkflow+      ]+    workflowShape field detail = breaking ((.id) newWorkflow) "workflow-input" ((.name) field) WorkflowShapeChanged detail++addedWorkflowDiff :: WorkflowNode -> [Change]+addedWorkflowDiff workflow = [additive ((.id) workflow) "workflow" ((.id) workflow) DeclarationAdded "new workflow"]++removedWorkflowDiff :: WorkflowNode -> [Change]+removedWorkflowDiff workflow = [breaking ((.id) workflow) "workflow" ((.id) workflow) WorkflowShapeChanged "workflow removed while in-flight journals and outcomes may still require its decoder"]++workflowIdentityDiff :: WorkflowNode -> WorkflowNode -> [Change]+workflowIdentityDiff oldWorkflow newWorkflow =+  [ breaking+      ((.id) newWorkflow)+      "workflow-name"+      ((.id) newWorkflow)+      WorkflowStableNameChanged+      ("stable name changed '" <> (.stable) oldWorkflow <> "' -> '" <> (.stable) newWorkflow <> "'; in-flight journals remain under the old stream name")+  | (.stable) oldWorkflow /= (.stable) newWorkflow+  ]+    ++ [ breaking+           ((.id) newWorkflow)+           "derived-identity"+           ((.id) newWorkflow)+           DerivedIdentityChanged+           "workflow id source field or derivation changed; journal and deterministic child/step identities no longer coalesce with persisted executions"+       | ((.idField) oldWorkflow, (.idVia) oldWorkflow) /= ((.idField) newWorkflow, (.idVia) newWorkflow)+       ]++intakeDiff :: DiffEnv -> [Change]+intakeDiff env =+  concatMap (uncurry intakePairDiff) ((.matched) paired)+    ++ concatMap addedIntakeDiff ((.added) paired)+    ++ concatMap removedIntakeDiff ((.removed) paired)+  where+    paired = pairByName nodeIntake (.name) env++intakePairDiff :: IntakeNode -> IntakeNode -> [Change]+intakePairDiff oldIntake newIntake =+  [ breaking+      ((.name) newIntake)+      "dedupe-identity"+      ((.name) newIntake)+      DedupeIdentityChanged+      "dedupe key or policy changed; redelivered messages no longer match their persisted dedupe record"+  | ((.dedupeKey) oldIntake, (.dedupePolicy) oldIntake) /= ((.dedupeKey) newIntake, (.dedupePolicy) newIntake)+  ]+    ++ [ advisory+           ((.name) newIntake)+           "decode-posture"+           ((.name) newIntake)+           DecodePostureChanged+           "envelope/body decode posture changed; future messages are accepted or rejected differently"+       | (.decode) oldIntake /= (.decode) newIntake+       ]+    ++ [ advisory+           ((.name) newIntake)+           "inbox-persistence"+           ((.name) newIntake)+           IntakePersistenceChanged+           ("success-path envelope persistence changed " <> renderInkPersist ((.persist) oldIntake) <> " -> " <> renderInkPersist ((.persist) newIntake) <> "; existing rows are unchanged while future successful rows retain a different envelope shape")+       | (.persist) oldIntake /= (.persist) newIntake+       ]++renderInkPersist :: InkPersist -> Text+renderInkPersist InkPersistFull = "full-envelope"+renderInkPersist InkPersistDedupeOnly = "dedupe-only"++addedIntakeDiff :: IntakeNode -> [Change]+addedIntakeDiff intake = [additive ((.name) intake) "intake" ((.name) intake) DeclarationAdded "new intake"]++removedIntakeDiff :: IntakeNode -> [Change]+removedIntakeDiff intake = [breaking ((.name) intake) "dedupe-identity" ((.name) intake) DedupeIdentityChanged "intake removed while persisted dedupe records and redeliveries may remain"]++emitDiff :: DiffEnv -> [Change]+emitDiff env =+  concatMap (uncurry emitPairDiff) ((.matched) paired)+    ++ concatMap addedEmitDiff ((.added) paired)+    ++ concatMap removedEmitDiff ((.removed) paired)+  where+    paired = pairByName nodeEmit (.name) env++emitPairDiff :: EmitNode -> EmitNode -> [Change]+emitPairDiff oldEmit newEmit =+  [ breaking+      ((.name) newEmit)+      "derived-identity"+      "messageId"+      DerivedIdentityChanged+      "messageId derive prefix changed; outbox retries no longer coalesce with persisted messages"+  | (.messageId) oldEmit /= (.messageId) newEmit+  ]+    ++ [ breaking+           ((.name) newEmit)+           "derived-identity"+           "idempotencyKey"+           DerivedIdentityChanged+           "idempotencyKey derive prefix changed; downstream dedupe no longer matches persisted messages"+       | (.idempotencyKey) oldEmit /= (.idempotencyKey) newEmit+       ]+    ++ [ advisory+           ((.name) newEmit)+           "emit-mapping"+           ((.name) newEmit)+           EmitMappingChanged+           "emit key, status discriminant, mapping rows, or explicit skip posture changed"+       | emitMapping oldEmit /= emitMapping newEmit+       ]++emitMapping :: EmitNode -> (Name, Name, [EmitMapRow], Bool)+emitMapping emit = ((.key) emit, (.discriminant) emit, (.map) emit, (.skip) emit)++addedEmitDiff :: EmitNode -> [Change]+addedEmitDiff emit = [additive ((.name) emit) "emit" ((.name) emit) DeclarationAdded "new emit mapping"]++removedEmitDiff :: EmitNode -> [Change]+removedEmitDiff emit = [breaking ((.name) emit) "derived-identity" ((.name) emit) DerivedIdentityChanged "emit removed while persisted outbox identities may still retry"]++publisherDiff :: DiffEnv -> [Change]+publisherDiff env =+  concatMap (uncurry publisherPairDiff) ((.matched) paired)+    ++ concatMap addedPublisherDiff ((.added) paired)+    ++ concatMap removedPublisherDiff ((.removed) paired)+  where+    paired = pairByName nodePublisher (.name) env++publisherPairDiff :: PublisherNode -> PublisherNode -> [Change]+publisherPairDiff oldPublisher newPublisher =+  -- maxAttempts/backoff are retry tuning, not persisted decode or identity.+  [ breaking+      ((.name) newPublisher)+      "derived-identity"+      "outboxId"+      DerivedIdentityChanged+      "stable outbox-id source field changed; retries no longer coalesce with persisted outbox rows"+  | (.outboxField) oldPublisher /= (.outboxField) newPublisher+  ]+    ++ [ advisory+           ((.name) newPublisher)+           "publisher-policy"+           ((.name) newPublisher)+           PublisherPolicyChanged+           ("ordering changed " <> (.ordering) oldPublisher <> " -> " <> (.ordering) newPublisher)+       | (.ordering) oldPublisher /= (.ordering) newPublisher+       ]++addedPublisherDiff :: PublisherNode -> [Change]+addedPublisherDiff publisher = [additive ((.name) publisher) "publisher" ((.name) publisher) DeclarationAdded "new publisher"]++removedPublisherDiff :: PublisherNode -> [Change]+removedPublisherDiff publisher = [breaking ((.name) publisher) "derived-identity" ((.name) publisher) DerivedIdentityChanged "publisher removed while persisted outbox rows may still require its stable identity"]++pgmqDispatchDiff :: DiffEnv -> [Change]+pgmqDispatchDiff env =+  concatMap (uncurry pgmqDispatchPairDiff) ((.matched) paired)+    ++ concatMap addedPgmqDispatchDiff ((.added) paired)+    ++ concatMap removedPgmqDispatchDiff ((.removed) paired)+  where+    paired = pairByName nodePgmqDispatch (.name) env++pgmqDispatchPairDiff :: PgmqDispatchNode -> PgmqDispatchNode -> [Change]+pgmqDispatchPairDiff oldDispatch newDispatch =+  [ breaking+      ((.name) newDispatch)+      "dedupe-identity"+      ((.name) newDispatch)+      DedupeIdentityChanged+      "dispatch dedupe key/read-model/queue surface changed; prior enqueue records no longer match"+  | dispatchDedupe oldDispatch /= dispatchDedupe newDispatch+  ]+    ++ [ advisory+           ((.name) newDispatch)+           "retarget"+           ((.name) newDispatch)+           DispatchRetargeted+           "source read model or target queue changed; future fan-out is routed differently"+       | dispatchTargets oldDispatch /= dispatchTargets newDispatch+       ]++dispatchDedupe :: PgmqDispatchNode -> (Name, Name, Text, Name, Text)+dispatchDedupe dispatch =+  ( (.dedupKey) dispatch,+    (.dedupReadModel) dispatch,+    (.dedupReadModelField) dispatch,+    (.dedupQueue) dispatch,+    (.dedupQueueField) dispatch+  )++dispatchTargets :: PgmqDispatchNode -> (Name, Name)+dispatchTargets dispatch = ((.sourceReadModel) dispatch, (.enqueueTo) dispatch)++addedPgmqDispatchDiff :: PgmqDispatchNode -> [Change]+addedPgmqDispatchDiff dispatch = [additive ((.name) dispatch) "dispatch" ((.name) dispatch) DeclarationAdded "new pgmq dispatch"]++removedPgmqDispatchDiff :: PgmqDispatchNode -> [Change]+removedPgmqDispatchDiff dispatch = [breaking ((.name) dispatch) "dedupe-identity" ((.name) dispatch) DedupeIdentityChanged "dispatch removed while persisted queue and read-model dedupe records may remain"]++-- | Classify the runtime's sanctioned workflow-evolution mechanisms before+-- falling back to the conservative unguarded-body rule.+classifyWorkflowBody :: WorkflowNode -> WorkflowNode -> [Change]+classifyWorkflowBody oldWorkflow newWorkflow+  | oldBody == newBody = []+  | not (null removedPatchIds) = map removedPatch removedPatchIds+  | Just (oldSeedType, newSeedType) <- changedSeed =+      [ breaking nodeName "workflow-continue-as-new" nodeName WorkflowContinueSeedChanged $+          "continueAsNew seed type changed " <> oldSeedType <> " -> " <> newSeedType <> "; the next generation's restoreSeed must decode the seed written by the previous generation"+      ]+  | safeAdditions =+      map addedPatch newPatchIds+        ++ [ additive nodeName "workflow-continue-as-new" seedType WorkflowEvolutionGuardAdded "terminal continueAsNew is additive; old generations carry no rotation marker"+           | Just seedType <- [appendedSeed]+           ]+  | otherwise =+      [ breaking+          nodeName+          "workflow-body"+          nodeName+          WorkflowBodyChanged+          "workflow body labels, kinds, result types, or order changed without a new patch guard; wrap a cross-cutting change in patch, or rename the replay label for one changed step"+      ]+  where+    nodeName = (.id) newWorkflow+    oldBody = normaliseWorkflowBody ((.body) oldWorkflow)+    newBody = normaliseWorkflowBody ((.body) newWorkflow)+    oldPatchIds = workflowBodyPatchIds oldBody+    newPatchIdsAll = workflowBodyPatchIds newBody+    newPatchIds = newPatchIdsAll \\ oldPatchIds+    removedPatchIds = oldPatchIds \\ newPatchIdsAll+    oldSeed = terminalContinueSeed oldBody+    newSeed = terminalContinueSeed newBody+    changedSeed = case (oldSeed, newSeed) of+      (Just oldSeedType, Just newSeedType)+        | oldSeedType /= newSeedType -> Just (oldSeedType, newSeedType)+      _ -> Nothing+    appendedSeed = case (oldSeed, newSeed) of+      (Nothing, Just seedType) -> Just seedType+      _ -> Nothing+    strippedNewBody = stripNewPatches newPatchIds newBody+    comparableNewBody = case appendedSeed of+      Just _ -> dropTerminalContinue strippedNewBody+      Nothing -> strippedNewBody+    safeAdditions =+      (not (null newPatchIds) || isJust appendedSeed)+        && comparableNewBody == oldBody+    removedPatch patchId =+      breaking nodeName "workflow-patch" patchId WorkflowPatchRemoved "patch id existed in the old spec but was removed; the differ cannot prove that no workflow generation still replays its journaled branch"+    addedPatch patchId =+      additive nodeName "workflow-patch" patchId WorkflowEvolutionGuardAdded "new patch guard contains the entire body change, so in-flight generations retain their journaled branch"++normaliseWorkflowBody :: [WfBodyItem] -> [WfBodyItem]+normaliseWorkflowBody = map go+  where+    go (WfStep label result _) = WfStep label result noLoc+    go (WfAwait label result _) = WfAwait label result noLoc+    go (WfSleep label delay _) = WfSleep label delay noLoc+    go (WfChild label via result _) = WfChild label via result noLoc+    go (WfPatch patchId items _) = WfPatch patchId (normaliseWorkflowBody items) noLoc+    go (WfContinueAsNew seedType _) = WfContinueAsNew seedType noLoc++workflowBodyPatchIds :: [WfBodyItem] -> [Name]+workflowBodyPatchIds = concatMap go+  where+    go (WfPatch patchId items _) = patchId : workflowBodyPatchIds items+    go _ = []++stripNewPatches :: [Name] -> [WfBodyItem] -> [WfBodyItem]+stripNewPatches newPatchIds = concatMap go+  where+    go (WfPatch patchId _ _) | patchId `elem` newPatchIds = []+    go (WfPatch patchId items loc) = [WfPatch patchId (stripNewPatches newPatchIds items) loc]+    go item = [item]++terminalContinueSeed :: [WfBodyItem] -> Maybe Name+terminalContinueSeed items = case reverse items of+  WfContinueAsNew seedType _ : _ -> Just seedType+  _ -> Nothing++dropTerminalContinue :: [WfBodyItem] -> [WfBodyItem]+dropTerminalContinue items = case reverse items of+  WfContinueAsNew {} : rest -> reverse rest+  _ -> items++additive :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change+additive n facet subj code detail =+  mkChange LabelAdditive (contextFor LabelAdditive n facet subj code) n facet subj code detail++breaking :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change+breaking n facet subj code detail =+  mkChange LabelBreaking (contextFor LabelBreaking n facet subj code) n facet subj code detail++advisory :: Name -> Text -> Text -> DiagnosticCode -> Text -> Change+advisory n facet subj code detail =+  mkChange LabelAdvisory (contextFor LabelAdvisory n facet subj code) n facet subj code detail++advisoryAt :: ChangeContext -> Name -> Text -> Text -> DiagnosticCode -> Text -> Change+advisoryAt context n facet subj code detail =+  mkChange LabelAdvisory context n facet subj code detail++mkChange :: Label -> ChangeContext -> Name -> Text -> Text -> DiagnosticCode -> Text -> Change+mkChange label context n facet subj code detail =+  wrap+    ChangeKind+      { node = n,+        facet = facet,+        subject = subj,+        code = code,+        context = context,+        vector = classifyCompatibility context code,+        mappedPersistedImpact = case (.contextKind) context of+          ContextQueue -> Just (MappedPersistedImpact (WorkqueueHistory ((.root) context)) VBreaking)+          _ -> Nothing,+        mappedConsequences = Set.empty,+        paths = (.paths) context,+        detail = detail+      }+  where+    wrap = case label of+      LabelAdditive -> Additive+      LabelAdvisory -> Advisory+      LabelBreaking -> Breaking++contextFor :: Label -> Name -> Text -> Text -> DiagnosticCode -> ChangeContext+contextFor label root facet subject code =+  setLabel $ case () of+    _+      | code `elem` publicCodes -> publicContractContext root paths+      | code `elem` queueCodes -> queueContext root paths+      | code `elem` identityCodes -> persistedIdentityContext root paths+      | code `elem` [OwnershipMoved, WorkspaceAuthorityChanged, GeneratedHaskellNameChanged] -> consumerBuildContext root paths+      | code == AggFoldSurfaceChanged -> snapshotContext root paths+      | code == EnumCtorAdded -> ChangeContext root paths ContextGeneral label+      | code `elem` privateCodes -> privateEventContext root paths+      | otherwise -> ChangeContext root paths ContextGeneral label+  where+    paths = [pathFor root facet subject]+    setLabel context = ChangeContext context.root context.paths context.contextKind label     publicCodes =       [ ContractEventRemoved,         ContractFieldChanged,

src/Keiro/Dsl/DiffReport.hs view

@@ -71,10 +71,10 @@   deriving stock (Eq, Show)  data DiffReport = DiffReport-  { reportGate :: !(Set CompatibilitySurface),-    reportFindings :: ![Change],-    reportSemanticImpact :: !(Maybe [MappedImpactDelta]),-    reportCoordinationImpact :: !(Maybe [CoordinationImpact])+  { gate :: !(Set CompatibilitySurface),+    findings :: ![Change],+    semanticImpact :: !(Maybe [MappedImpactDelta]),+    coordinationImpact :: !(Maybe [CoordinationImpact])   }   deriving stock (Eq, Show) @@ -94,36 +94,36 @@  -- | One source location from a composed workspace's ownership index. data OwnedSite = OwnedSite-  { osFile :: !FilePath,-    osLine :: !Int+  { file :: !FilePath,+    line :: !Int   }   deriving stock (Eq, Show)  -- | A merged-graph finding enriched with declaration and use-site ownership. data WorkspaceChange = WorkspaceChange-  { wcChange :: !Change,-    wcDeclarationSite :: !(Maybe OwnedSite),-    wcUseSites :: ![(Text, Maybe OwnedSite)]+  { change :: !Change,+    declarationSite :: !(Maybe OwnedSite),+    useSites :: ![(Text, Maybe OwnedSite)]   }   deriving stock (Eq, Show)  -- | Provenance for the two workspace graphs compared by one command. data WorkspaceMeta = WorkspaceMeta-  { wmIdentity :: !Text,-    wmManifest :: !FilePath,-    wmSince :: !Text,-    wmMembersOld :: ![FilePath],-    wmMembersNew :: ![FilePath],-    wmAdoptionBaseline :: !Bool+  { identity :: !Text,+    manifest :: !FilePath,+    since :: !Text,+    membersOld :: ![FilePath],+    membersNew :: ![FilePath],+    adoptionBaseline :: !Bool   }   deriving stock (Eq, Show)  data WorkspaceDiffReport = WorkspaceDiffReport-  { workspaceReportMeta :: !WorkspaceMeta,-    workspaceReportGate :: !(Set CompatibilitySurface),-    workspaceReportFindings :: ![WorkspaceChange],-    workspaceReportSemanticImpact :: !(Maybe [MappedImpactDelta]),-    workspaceReportCoordinationImpact :: !(Maybe [CoordinationImpact])+  { meta :: !WorkspaceMeta,+    gate :: !(Set CompatibilitySurface),+    findings :: ![WorkspaceChange],+    semanticImpact :: !(Maybe [MappedImpactDelta]),+    coordinationImpact :: !(Maybe [CoordinationImpact])   }   deriving stock (Eq, Show) @@ -143,30 +143,30 @@   toJSON report =     object $       [ "schema" .= ("keiro-dsl/diff-report/1" :: Text),-        "gate" .= map surfaceName (Set.toAscList (reportGate report)),-        "breaking" .= (any (gatedBreaking (reportGate report)) (reportFindings report) || coordinationBreaking (reportCoordinationImpact report)),-        "findings" .= map (findingValue (reportGate report)) (reportFindings report)+        "gate" .= map surfaceName (Set.toAscList ((.gate) report)),+        "breaking" .= (any (gatedBreaking ((.gate) report)) ((.findings) report) || coordinationBreaking ((.coordinationImpact) report)),+        "findings" .= map (findingValue ((.gate) report)) ((.findings) report)       ]-        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [reportSemanticImpact report]]-        <> ["coordinationImpact" .= impact | Just impact <- [reportCoordinationImpact report]]+        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [(.semanticImpact) report]]+        <> ["coordinationImpact" .= impact | Just impact <- [(.coordinationImpact) report]]  instance ToJSON WorkspaceDiffReport where   toJSON report =     object $       [ "schema" .= ("keiro-dsl/diff-report/1" :: Text),-        "gate" .= map surfaceName (Set.toAscList (workspaceReportGate report)),-        "breaking" .= (any (gatedBreaking (workspaceReportGate report) . wcChange) (workspaceReportFindings report) || coordinationBreaking (workspaceReportCoordinationImpact report)),-        "findings" .= map (workspaceFindingValue (workspaceReportGate report)) (workspaceReportFindings report),-        "workspace" .= workspaceMetaValue (workspaceReportMeta report)+        "gate" .= map surfaceName (Set.toAscList ((.gate) report)),+        "breaking" .= (any (gatedBreaking ((.gate) report) . (.change)) ((.findings) report) || coordinationBreaking ((.coordinationImpact) report)),+        "findings" .= map (workspaceFindingValue ((.gate) report)) ((.findings) report),+        "workspace" .= workspaceMetaValue ((.meta) report)       ]-        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [workspaceReportSemanticImpact report]]-        <> ["coordinationImpact" .= impact | Just impact <- [workspaceReportCoordinationImpact report]]+        <> ["semanticImpact" .= semanticImpactValue impact | Just impact <- [(.semanticImpact) report]]+        <> ["coordinationImpact" .= impact | Just impact <- [(.coordinationImpact) report]]  semanticImpactValue :: [MappedImpactDelta] -> Value semanticImpactValue impact = object ["declarations" .= impact]  coordinationBreaking :: Maybe [CoordinationImpact] -> Bool-coordinationBreaking = maybe False (any ((== CoordinationBreaking) . coordinationSeverity))+coordinationBreaking = maybe False (any ((== CoordinationBreaking) . (.severity)))  -- | Human-facing semantic dependency summary, kept separate from ordinary -- compatibility findings and generated-file evidence.@@ -175,14 +175,14 @@ renderSemanticImpact impact = "semantic impact:" : concatMap renderDelta impact   where     renderDelta delta =-      [ "  " <> unMappedKey (impactDeclaration delta),-        "    previous aggregate consumers: " <> renderBaseline (impactPreviousEvidence delta) (renderConsumers (impactPreviousConsumers delta)),-        "    current aggregate consumers:  " <> renderConsumers (impactCurrentConsumers delta),-        "    previous roots: " <> maybe "baseline unavailable" renderEvidence (impactPreviousEvidence delta),-        "    current roots:  " <> maybe "baseline unavailable" renderEvidence (impactCurrentEvidence delta),-        "    previous consequences: " <> maybe "baseline unavailable" renderConsequences (impactPreviousConsequences delta),-        "    current consequences:  " <> maybe "baseline unavailable" renderConsequences (impactCurrentConsequences delta),-        "    service-conformance: " <> if impactServiceConformance delta then "impacted" else "unchanged"+      [ "  " <> (.unMappedKey) ((.declaration) delta),+        "    previous aggregate consumers: " <> renderBaseline ((.previousEvidence) delta) (renderConsumers ((.previousConsumers) delta)),+        "    current aggregate consumers:  " <> renderConsumers ((.currentConsumers) delta),+        "    previous roots: " <> maybe "baseline unavailable" renderEvidence ((.previousEvidence) delta),+        "    current roots:  " <> maybe "baseline unavailable" renderEvidence ((.currentEvidence) delta),+        "    previous consequences: " <> maybe "baseline unavailable" renderConsequences ((.previousConsequences) delta),+        "    current consequences:  " <> maybe "baseline unavailable" renderConsequences ((.currentConsequences) delta),+        "    service-conformance: " <> if (.serviceConformance) delta then "impacted" else "unchanged"       ]     renderConsumers aggregateConsumers = case map consumerName (Set.toAscList aggregateConsumers) of       [] -> "(none)"@@ -192,8 +192,8 @@     renderBaseline (Just _) value = value     renderEvidence values = renderSet renderRoot values     renderRoot evidence =-      T.intercalate "|" [mappedRootKindIdentity (evidenceRootKind evidence), mappedConsumerIdentity (evidenceConsumer evidence), evidencePath evidence]-        <> maybe "" ("|" <>) (evidenceOperation evidence)+      T.intercalate "|" [mappedRootKindIdentity ((.rootKind) evidence), mappedConsumerIdentity ((.consumer) evidence), (.path) evidence]+        <> maybe "" ("|" <>) ((.operation) evidence)     renderConsequences = renderSet mappedConsequenceIdentity     renderSet render values = case map render (Set.toAscList values) of       [] -> "(none)"@@ -205,43 +205,43 @@ workspaceFindingValue :: Set CompatibilitySurface -> WorkspaceChange -> Value workspaceFindingValue gate workspaceChange =   object-    ( findingPairs gate (wcChange workspaceChange)-        <> maybe [] (\site -> ["declaration" .= ownedSiteValue site]) (wcDeclarationSite workspaceChange)-        <> ["useSites" .= map useSiteValue (wcUseSites workspaceChange) | not (null (wcUseSites workspaceChange))]+    ( findingPairs gate ((.change) workspaceChange)+        <> maybe [] (\site -> ["declaration" .= ownedSiteValue site]) ((.declarationSite) workspaceChange)+        <> ["useSites" .= map useSiteValue ((.useSites) workspaceChange) | not (null ((.useSites) workspaceChange))]     )  findingPairs :: Set CompatibilitySurface -> Change -> [Pair] findingPairs gate change =-  [ "label" .= labelName (deriveLabel gate (ckVector kind)),-    "node" .= ckNode kind,-    "facet" .= ckFacet kind,-    "subject" .= ckSubject kind,-    "code" .= T.pack (show (ckCode kind)),-    "paths" .= ckPaths kind,-    "vector" .= vectorValue (ckVector kind),-    "detail" .= ckDetail kind,-    "remedies" .= map renderRemedy (NonEmpty.toList (remediationFor (ckContext kind) (ckCode kind)))+  [ "label" .= labelName (deriveLabel gate ((.vector) kind)),+    "node" .= (.node) kind,+    "facet" .= (.facet) kind,+    "subject" .= (.subject) kind,+    "code" .= T.pack (show ((.code) kind)),+    "paths" .= (.paths) kind,+    "vector" .= vectorValue ((.vector) kind),+    "detail" .= (.detail) kind,+    "remedies" .= map renderRemedy (NonEmpty.toList (remediationFor ((.context) kind) ((.code) kind)))   ]-    <> ["mappedPersistedSurface" .= mappedPersistedImpactValue impact | Just impact <- [ckMappedPersistedImpact kind]]-    <> ["mappedConsequences" .= map mappedConsequenceIdentity (Set.toAscList (ckMappedConsequences kind)) | not (Set.null (ckMappedConsequences kind))]+    <> ["mappedPersistedSurface" .= mappedPersistedImpactValue impact | Just impact <- [(.mappedPersistedImpact) kind]]+    <> ["mappedConsequences" .= map mappedConsequenceIdentity (Set.toAscList ((.mappedConsequences) kind)) | not (Set.null ((.mappedConsequences) kind))]   where     kind = changeKind change  ownedSiteValue :: OwnedSite -> Value-ownedSiteValue site = object ["file" .= osFile site, "line" .= osLine site]+ownedSiteValue site = object ["file" .= (.file) site, "line" .= (.line) site]  useSiteValue :: (Text, Maybe OwnedSite) -> Value useSiteValue (path, site) =   object     ( ["path" .= path]-        <> maybe [] (\owned -> ["file" .= osFile owned, "line" .= osLine owned]) site+        <> maybe [] (\owned -> ["file" .= (.file) owned, "line" .= (.line) owned]) site     )  mappedPersistedImpactValue :: MappedPersistedImpact -> Value mappedPersistedImpactValue impact =   object-    [ "surface" .= persistedSurfaceName (mappedPersistedSurface impact),-      "verdict" .= verdictName (mappedPersistedVerdict impact)+    [ "surface" .= persistedSurfaceName ((.surface) impact),+      "verdict" .= verdictName ((.verdict) impact)     ]  persistedSurfaceName :: MappedPersistedSurface -> Text@@ -252,24 +252,24 @@ workspaceMetaValue :: WorkspaceMeta -> Value workspaceMetaValue meta =   object-    [ "identity" .= wmIdentity meta,-      "manifest" .= wmManifest meta,-      "since" .= wmSince meta,-      "membersOld" .= wmMembersOld meta,-      "membersNew" .= wmMembersNew meta,-      "adoptionBaseline" .= wmAdoptionBaseline meta+    [ "identity" .= (.identity) meta,+      "manifest" .= (.manifest) meta,+      "since" .= (.since) meta,+      "membersOld" .= (.membersOld) meta,+      "membersNew" .= (.membersNew) meta,+      "adoptionBaseline" .= (.adoptionBaseline) meta     ]  vectorValue :: CompatibilityVector -> Value vectorValue vector =   object-    [ "private-history-read" .= verdictName (cvPrivateHistoryRead vector),-      "old-binary-read-new-events" .= verdictName (cvOldBinaryReadNewEvents vector),-      "snapshot-hydration" .= verdictName (cvSnapshotHydration vector),-      "public-consumer" .= verdictName (cvPublicConsumer vector),-      "persisted-identity" .= verdictName (cvPersistedIdentity vector),-      "consumer-build" .= verdictName (cvConsumerBuild vector),-      "rollout" .= map rolloutName (Set.toAscList (cvRollout vector))+    [ "private-history-read" .= verdictName ((.privateHistoryRead) vector),+      "old-binary-read-new-events" .= verdictName ((.oldBinaryReadNewEvents) vector),+      "snapshot-hydration" .= verdictName ((.snapshotHydration) vector),+      "public-consumer" .= verdictName ((.publicConsumer) vector),+      "persisted-identity" .= verdictName ((.persistedIdentity) vector),+      "consumer-build" .= verdictName ((.consumerBuild) vector),+      "rollout" .= map rolloutName (Set.toAscList ((.rollout) vector))     ]  remediationFor :: ChangeContext -> DiagnosticCode -> NonEmpty Remedy@@ -308,45 +308,45 @@       RemedyDeploymentOrder RolloutWorkersFirst :| [RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRunConformance]   | code `elem` identityCodes =       RemedyDoNotDeploy "revert the re-keying change or perform an explicit operational identity migration" :| []-  | code == EnumCtorAdded = case Set.toAscList (cvRollout vector) of+  | code == EnumCtorAdded = case Set.toAscList ((.rollout) vector) of       rollout : _ -> RemedyDeploymentOrder rollout :| [snapshotRemedy]       [] -> snapshotRemedy :| []-  | cvConsumerBuild vector `elem` [VAdvisory, VBreaking] =+  | (.consumerBuild) vector `elem` [VAdvisory, VBreaking] =       RemedyRecompileConsumers :| [RemedyRunConformance]   | Just rollout <- firstRollout = RemedyDeploymentOrder rollout :| [RemedyRunConformance]-  | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]+  | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]   | otherwise = RemedyRunConformance :| []   where     vector = classifyCompatibility context code-    firstRollout = case Set.toAscList (cvRollout vector) of+    firstRollout = case Set.toAscList ((.rollout) vector) of       rollout : _ -> Just rollout       [] -> Nothing     snapshotRemedy-      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump+      | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump       | otherwise = RemedyRunConformance     mappedWireRemedy-      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy-      | cvPrivateHistoryRead vector == VBreaking =+      | Set.member RolloutDrainRequired ((.rollout) vector) = queueMappedRemedy+      | (.privateHistoryRead) vector == VBreaking =           RemedyVersionBump :| [RemedyUpcaster, RemedyDeploymentOrder RolloutStopTheWorld]-      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]+      | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]       | otherwise = RemedyRecompileConsumers :| [RemedyRunConformance]     mappedAdditionRemedy-      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]-      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy+      | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]+      | Set.member RolloutDrainRequired ((.rollout) vector) = queueMappedRemedy       | Just rollout <- firstRollout = RemedyDeploymentOrder rollout :| [RemedyRunConformance]       | otherwise = RemedyRunConformance :| []     mappedConformanceRemedy-      | cvSnapshotHydration vector == VAdvisory = RemedyRunConformance :| [RemedyStateCodecBump]-      | Set.member RolloutDrainRequired (cvRollout vector) = queueMappedRemedy+      | (.snapshotHydration) vector == VAdvisory = RemedyRunConformance :| [RemedyStateCodecBump]+      | Set.member RolloutDrainRequired ((.rollout) vector) = queueMappedRemedy       | otherwise = RemedyRunConformance :| []     queueMappedRemedy =       RemedyDeploymentOrder RolloutWorkersFirst         :| [RemedyDrainWorkqueue, RemedyTransitionalQueueCodec, RemedyRecompileConsumers, RemedyRunConformance]     mappedSnapshotConformanceRemedy-      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]+      | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump :| [RemedyRunConformance]       | otherwise = RemedyRunConformance :| []     mappedCanonicalRemedy-      | cvSnapshotHydration vector == VAdvisory = RemedyStateCodecBump :| [RemedyRecompileConsumers, RemedyRunConformance]+      | (.snapshotHydration) vector == VAdvisory = RemedyStateCodecBump :| [RemedyRecompileConsumers, RemedyRunConformance]       | otherwise = RemedyRecompileConsumers :| [RemedyRunConformance]     mappedWireCodes =       [ MappedFieldAddedNoDefault,@@ -437,29 +437,29 @@     headline =       headlineName change         <> ": "-        <> ckNode kind+        <> (.node) kind         <> " "-        <> ckFacet kind+        <> (.facet) kind         <> " "-        <> ckSubject kind+        <> (.subject) kind         <> ": "-        <> ckDetail kind+        <> (.detail) kind         <> codeSuffix change kind     vectorDetail-      | vectorIsUniform (ckVector kind) = ""-      | otherwise = "\n" <> renderVectorLine (ckVector kind)-    persistedDetail = case ckMappedPersistedImpact kind of+      | vectorIsUniform ((.vector) kind) = ""+      | otherwise = "\n" <> renderVectorLine ((.vector) kind)+    persistedDetail = case (.mappedPersistedImpact) kind of       Nothing -> ""       Just impact ->         "\n    mapped-persisted-surface: "-          <> persistedSurfaceName (mappedPersistedSurface impact)+          <> persistedSurfaceName ((.surface) impact)           <> "="-          <> verdictName (mappedPersistedVerdict impact)+          <> verdictName ((.verdict) impact)     consequenceDetail-      | Set.null (ckMappedConsequences kind) = ""+      | Set.null ((.mappedConsequences) kind) = ""       | otherwise =           "\n    mapped-consequences: "-            <> T.intercalate ", " (map mappedConsequenceIdentity (Set.toAscList (ckMappedConsequences kind)))+            <> T.intercalate ", " (map mappedConsequenceIdentity (Set.toAscList ((.mappedConsequences) kind)))  renderVectorLine :: CompatibilityVector -> Text renderVectorLine vector =@@ -470,27 +470,27 @@           let verdict = verdictFor surface vector,           verdict /= VNotApplicable         ]-          <> ["rollout=" <> T.intercalate "," (map rolloutName (Set.toAscList (cvRollout vector))) | not (Set.null (cvRollout vector))]+          <> ["rollout=" <> T.intercalate "," (map rolloutName (Set.toAscList ((.rollout) vector))) | not (Set.null ((.rollout) vector))]       )  renderExplainBlock :: Change -> Text renderExplainBlock change =   "explain ["-    <> T.pack (show (ckCode kind))+    <> T.pack (show ((.code) kind))     <> "]\n"-    <> T.unlines ["  path: " <> path | path <- ckPaths kind]+    <> T.unlines ["  path: " <> path | path <- (.paths) kind]     <> T.unlines (map ("  direction: " <>) directions)     <> T.unlines ["  remedy: " <> renderRemedy remedy | remedy <- NonEmpty.toList remedies]   where     kind = changeKind change-    vector = ckVector kind+    vector = (.vector) kind     directions =       [ surfaceName surface <> " is " <> verdictName verdict <> "; " <> directionMeaning surface verdict       | surface <- [minBound .. maxBound],         let verdict = verdictFor surface vector,         verdict `elem` [VAdvisory, VBreaking]       ]-    remedies = remediationFor (ckContext kind) (ckCode kind)+    remedies = remediationFor ((.context) kind) ((.code) kind)  surfaceName :: CompatibilitySurface -> Text surfaceName surface = case surface of@@ -540,7 +540,7 @@  codeSuffix :: Change -> ChangeKind -> Text codeSuffix Additive {} _ = ""-codeSuffix _ kind = " [" <> T.pack (show (ckCode kind)) <> "]"+codeSuffix _ kind = " [" <> T.pack (show ((.code) kind)) <> "]"  changeKind :: Change -> ChangeKind changeKind (Additive kind) = kind@@ -549,7 +549,7 @@  vectorIsUniform :: CompatibilityVector -> Bool vectorIsUniform vector =-  Set.null (cvRollout vector)+  Set.null ((.rollout) vector)     && all (`elem` [VCompatible, VNotApplicable]) [verdictFor surface vector | surface <- [minBound .. maxBound]]  directionMeaning :: CompatibilitySurface -> SurfaceVerdict -> Text

src/Keiro/Dsl/EventOutput.hs view

@@ -10,6 +10,7 @@ module Keiro.Dsl.EventOutput   ( CheckedFieldCopy (..),     OutputObligationKey (..),+    unOutputObligationKey,     EventOutputMapping (..),     EventOutputError (..),     eventOutputMapping,@@ -42,14 +43,17 @@ newtype OutputObligationKey = OutputObligationKey {unOutputObligationKey :: Text}   deriving stock (Eq, Ord, Show) +unOutputObligationKey :: OutputObligationKey -> Text+unOutputObligationKey (OutputObligationKey value) = value+ -- | Exclusive ownership of one event term emitted by one transition. data EventOutputMapping   = GeneratedCommandIdentity-      { outputSourceCommand :: !Name,-        outputFields :: ![CheckedFieldCopy]+      { sourceCommand :: !Name,+        fields :: ![CheckedFieldCopy]       }   | HandOwnedEventOutput-      { outputObligation :: !OutputObligationKey+      { obligation :: !OutputObligationKey       }   deriving stock (Eq, Ord, Show) @@ -76,43 +80,43 @@  eventOutputMappingFromGraphResult :: Either (NonEmpty TypeGraphError) TypeGraph -> Spec -> Aggregate -> Transition -> Int -> Name -> Either EventOutputError EventOutputMapping eventOutputMappingFromGraphResult typeGraphResult spec aggregate transition emitIndex eventName = do-  event <- maybe (Left (OutputEventMissing eventName)) Right (find ((== eventName) . evName) (aggEvents aggregate))-  case (tImplementation transition, evBody event) of+  event <- maybe (Left (OutputEventMissing eventName)) Right (find ((== eventName) . (.name)) ((.events) aggregate))+  case ((.implementation) transition, (.body) event) of     (LegacyHoleImplementation, _) -> pure handOwned     (_, EventFields _) -> pure handOwned     (_, EventFromCommand sourceCommand)-      | sourceCommand /= tCommand transition ->+      | sourceCommand /= (.command) transition ->           Left             OutputCommandMismatch               { declaredSourceCommand = sourceCommand,-                consumingTransitionCommand = tCommand transition,+                consumingTransitionCommand = (.command) transition,                 emittedEventName = eventName               }       | otherwise -> do-          command <- maybe (Left (OutputSourceCommandMissing sourceCommand)) Right (find ((== sourceCommand) . cmdName) (aggCommands aggregate))-          fields <- traverse checkedCopy (cmdFields command)+          command <- maybe (Left (OutputSourceCommandMissing sourceCommand)) Right (find ((== sourceCommand) . (.name)) ((.commands) aggregate))+          fields <- traverse checkedCopy ((.fields) command)           pure             GeneratedCommandIdentity-              { outputSourceCommand = sourceCommand,-                outputFields = fields+              { sourceCommand = sourceCommand,+                fields = fields               }   where     symbols = aggregateSymbolsFromGraphResult typeGraphResult spec     handOwned =       HandOwnedEventOutput-        { outputObligation =+        { obligation =             OutputObligationKey               ( T.intercalate                   "/"                   [ "event-output-v1",-                    aggName aggregate,-                    transitionModeName (tMode transition),-                    tSource transition,-                    tCommand transition,-                    maybe "unguarded" renderExpr (tGuard transition),-                    T.intercalate ";" [register <> ":=" <> renderExpr expression | (register, expression) <- tWrites transition],-                    T.intercalate "," (tEmits transition),-                    tGoto transition,+                    (.name) aggregate,+                    transitionModeName ((.mode) transition),+                    (.source) transition,+                    (.command) transition,+                    maybe "unguarded" renderExpr ((.guard) transition),+                    T.intercalate ";" [register <> ":=" <> renderExpr expression | (register, expression) <- (.writes) transition],+                    T.intercalate "," ((.emits) transition),+                    (.goto) transition,                     T.pack (show emitIndex),                     eventName                   ]@@ -125,11 +129,11 @@         then           pure             CheckedFieldCopy-              { outputSelector = aggregateFieldName field,-                outputWireName = aggregateFieldName field,+              { outputSelector = (.name) field,+                outputWireName = (.name) field,                 outputFieldType = commandType               }-        else Left (OutputFieldTypeMismatch (aggregateFieldName field) commandType eventType)+        else Left (OutputFieldTypeMismatch ((.name) field) commandType eventType)  -- | Canonical ownership text used by fold and behavior fingerprints. eventOutputCanonical :: EventOutputMapping -> Text@@ -140,11 +144,11 @@       <> "["       <> T.intercalate         ","-        [ outputSelector field+        [ (.outputSelector) field             <> "="-            <> outputWireName field+            <> (.outputWireName) field             <> ":"-            <> aggregateCanonicalName (outputFieldType field)+            <> aggregateCanonicalName ((.outputFieldType) field)         | field <- fields         ]       <> "]"

src/Keiro/Dsl/ExplainBindings.hs view

@@ -42,28 +42,28 @@   deriving stock (Eq, Ord, Show)  data BindingObligation = BindingObligation-  { obligationMappedName :: !Name,-    obligationPackage :: !Text,-    obligationModule :: !Text,-    obligationSymbol :: !Text,-    obligationKind :: !BindingObligationKind,-    obligationSignature :: !Text,-    obligationUseSites :: ![Text],-    obligationBindingVersion :: !(Maybe Text),-    obligationCanonicalType :: !(Maybe Text),-    obligationEqualityContract :: !(Maybe Text),-    obligationIdDomainContract :: !(Maybe Text),-    obligationCategory :: !Text+  { mappedName :: !Name,+    package :: !Text,+    moduleName :: !Text,+    symbol :: !Text,+    kind :: !BindingObligationKind,+    signature :: !Text,+    useSites :: ![Text],+    bindingVersion :: !(Maybe Text),+    canonicalType :: !(Maybe Text),+    equalityContract :: !(Maybe Text),+    idDomainContract :: !(Maybe Text),+    category :: !Text   }   deriving stock (Eq, Ord, Show)  data BindingHole = BindingHole-  { holeMappedName :: !Name,-    holeModule :: !Text,-    holeSymbol :: !Text,-    holeKind :: !BindingObligationKind,-    holePath :: !(Maybe Text),-    holeSignature :: !Text+  { mappedName :: !Name,+    moduleName :: !Text,+    symbol :: !Text,+    kind :: !BindingObligationKind,+    path :: !(Maybe Text),+    signature :: !Text   }   deriving stock (Eq, Ord, Show) @@ -71,18 +71,18 @@   toJSON obligation =     object       [ "schema" .= (1 :: Int),-        "mappedName" .= obligationMappedName obligation,-        "package" .= obligationPackage obligation,-        "module" .= obligationModule obligation,-        "symbol" .= obligationSymbol obligation,-        "kind" .= renderKind (obligationKind obligation),-        "signature" .= obligationSignature obligation,-        "useSites" .= obligationUseSites obligation,-        "bindingVersion" .= obligationBindingVersion obligation,-        "canonicalType" .= obligationCanonicalType obligation,-        "equalityContract" .= obligationEqualityContract obligation,-        "idDomainContract" .= obligationIdDomainContract obligation,-        "category" .= obligationCategory obligation+        "mappedName" .= (.mappedName) obligation,+        "package" .= (.package) obligation,+        "module" .= (.moduleName) obligation,+        "symbol" .= (.symbol) obligation,+        "kind" .= renderKind ((.kind) obligation),+        "signature" .= (.signature) obligation,+        "useSites" .= (.useSites) obligation,+        "bindingVersion" .= (.bindingVersion) obligation,+        "canonicalType" .= (.canonicalType) obligation,+        "equalityContract" .= (.equalityContract) obligation,+        "idDomainContract" .= (.idDomainContract) obligation,+        "category" .= (.category) obligation       ]  instance FromJSON BindingObligation where@@ -111,12 +111,12 @@   toJSON hole =     object       [ "schema" .= (1 :: Int),-        "mappedName" .= holeMappedName hole,-        "module" .= holeModule hole,-        "symbol" .= holeSymbol hole,-        "kind" .= renderKind (holeKind hole),-        "path" .= holePath hole,-        "signature" .= holeSignature hole+        "mappedName" .= (.mappedName) hole,+        "module" .= (.moduleName) hole,+        "symbol" .= (.symbol) hole,+        "kind" .= renderKind ((.kind) hole),+        "path" .= (.path) hole,+        "signature" .= (.signature) hole       ]  instance FromJSON BindingHole where@@ -145,7 +145,7 @@   pure . sortOn obligationSortKey $     concat       [ obligationsFor graph declaration-      | ResolvedStructural declaration _ <- Map.elems (tgDeclarations graph)+      | ResolvedStructural declaration _ <- Map.elems ((.declarations) graph)       ]       <> concatMap (nominalObligationsFor service) (Map.elems (nominalTypes nominalRegistry))   where@@ -161,61 +161,61 @@   pure . sortOn holeSortKey $     concat       [ holesFor graph declaration shape obligations-      | ResolvedStructural declaration shape <- Map.elems (tgDeclarations graph)+      | ResolvedStructural declaration shape <- Map.elems ((.declarations) graph)       ]       <> [ BindingHole-             { holeMappedName = obligationMappedName obligation,-               holeModule = obligationModule obligation,-               holeSymbol = obligationSymbol obligation,-               holeKind = obligationKind obligation,-               holePath = Nothing,-               holeSignature = obligationSignature obligation+             { mappedName = (.mappedName) obligation,+               moduleName = (.moduleName) obligation,+               symbol = (.symbol) obligation,+               kind = (.kind) obligation,+               path = Nothing,+               signature = (.signature) obligation              }          | obligation <- obligations,-           obligationCategory obligation /= "structural"+           (.category) obligation /= "structural"          ]  holesFor :: TypeGraph -> StructuralDecl -> ResolvedMappedShape -> [BindingObligation] -> [BindingHole] holesFor _graph declaration shape obligations = bindingEntries <> auxiliaryEntries   where-    own = filter ((== sdName declaration) . obligationMappedName) obligations+    own = filter ((== (.name) declaration) . (.mappedName)) obligations     binding = onlyKind BindingValue     bindingEntries = case binding of       Nothing -> []       Just obligation -> map (bindingHole obligation) (shapeHolePaths shape)     auxiliaryEntries =       [ BindingHole-          { holeMappedName = obligationMappedName obligation,-            holeModule = obligationModule obligation,-            holeSymbol = obligationSymbol obligation,-            holeKind = obligationKind obligation,-            holePath = Nothing,-            holeSignature = obligationSignature obligation+          { mappedName = (.mappedName) obligation,+            moduleName = (.moduleName) obligation,+            symbol = (.symbol) obligation,+            kind = (.kind) obligation,+            path = Nothing,+            signature = (.signature) obligation           }       | obligation <- own,-        obligationKind obligation /= BindingValue+        (.kind) obligation /= BindingValue       ]-    onlyKind wanted = case filter ((== wanted) . obligationKind) own of+    onlyKind wanted = case filter ((== wanted) . (.kind)) own of       entry : _ -> Just entry       [] -> Nothing     bindingHole obligation (path, expectedType) =       BindingHole-        { holeMappedName = obligationMappedName obligation,-          holeModule = obligationModule obligation,-          holeSymbol = obligationSymbol obligation,-          holeKind = BindingValue,-          holePath = Just path,-          holeSignature = obligationSymbol obligation <> "." <> path <> " :: " <> expectedType+        { mappedName = (.mappedName) obligation,+          moduleName = (.moduleName) obligation,+          symbol = (.symbol) obligation,+          kind = BindingValue,+          path = Just path,+          signature = (.symbol) obligation <> "." <> path <> " :: " <> expectedType         }  shapeHolePaths :: ResolvedMappedShape -> [(Text, Text)] shapeHolePaths =   foldMappedShape     MappedShapeAlgebra-      { onRecord = \_ _ fields -> [(rwfHaskell field, renderExprType (rwfType field)) | field <- fields],-        onEnum = \entries -> [(weCtor entry, "constructor case") | entry <- entries],+      { onRecord = \_ _ fields -> [((.haskell) field, renderExprType ((.valueType) field)) | field <- fields],+        onEnum = \entries -> [((.ctor) entry, "constructor case") | entry <- entries],         onUnion = \_ arms ->-          [ (rwaCtor arm, maybe "constructor case" renderExprType (rwaPayload arm))+          [ ((.ctor) arm, maybe "constructor case" renderExprType ((.payload) arm))           | arm <- arms           ]       }@@ -240,73 +240,73 @@ obligationsFor :: TypeGraph -> StructuralDecl -> [BindingObligation] obligationsFor graph declaration = bindingEntry : fixtureEntry : initialEntries   where-    source = sdHaskell declaration-    consumerType = hsModule source <> "." <> hsType source-    shapeType = sdName declaration <> "Shape"-    paths = map renderUsePath (usePaths graph (sdName declaration))+    source = (.haskell) declaration+    consumerType = (.moduleName) source <> "." <> (.valueType) source+    shapeType = (.name) declaration <> "Shape"+    paths = map renderUsePath (usePaths graph ((.name) declaration))     registerPaths =       [ renderUsePath path-      | path@UsePath {upRoot = RootRegister {}} <- usePaths graph (sdName declaration)+      | path@UsePath {root = RootRegister {}} <- usePaths graph ((.name) declaration)       ]     bindingEntry =       obligationFor         declaration-        (sdBinding declaration)+        ((.binding) declaration)         BindingValue         ("StructuralBinding " <> consumerType <> " " <> shapeType)         paths-        (Just (unBindingVersion (sdBindingVersion declaration)))-        (Just (unCanonicalTypeId (sdCanonical declaration)))+        (Just (unBindingVersion ((.bindingVersion) declaration)))+        (Just (unCanonicalTypeId ((.canonical) declaration)))     fixtureEntry =       obligationFor         declaration-        (sdFixtures declaration)+        ((.fixtures) declaration)         FixtureValue         ("FixtureCases " <> consumerType)         paths         Nothing-        (Just (unCanonicalTypeId (sdCanonical declaration)))-    initialEntries = case (registerPaths, sdInitial declaration) of+        (Just (unCanonicalTypeId ((.canonical) declaration)))+    initialEntries = case (registerPaths, (.initial) declaration) of       ([], _) -> []       (_, Nothing) -> []       (_, Just initialValue) ->-        [ obligationFor declaration initialValue InitialValue consumerType registerPaths Nothing (Just (unCanonicalTypeId (sdCanonical declaration)))+        [ obligationFor declaration initialValue InitialValue consumerType registerPaths Nothing (Just (unCanonicalTypeId ((.canonical) declaration)))         ]  obligationFor :: StructuralDecl -> QualifiedValueName -> BindingObligationKind -> Text -> [Text] -> Maybe Text -> Maybe Text -> BindingObligation obligationFor declaration qualified kindValue signature paths version canonical =   BindingObligation-    { obligationMappedName = sdName declaration,-      obligationPackage = hsPackage (sdHaskell declaration),-      obligationModule = ownerModule,-      obligationSymbol = symbol,-      obligationKind = kindValue,-      obligationSignature = symbol <> " :: " <> signature,-      obligationUseSites = paths,-      obligationBindingVersion = version,-      obligationCanonicalType = canonical,-      obligationEqualityContract = Nothing,-      obligationIdDomainContract = Nothing,-      obligationCategory = "structural"+    { mappedName = (.name) declaration,+      package = (.package) ((.haskell) declaration),+      moduleName = ownerModule,+      symbol = symbol,+      kind = kindValue,+      signature = symbol <> " :: " <> signature,+      useSites = paths,+      bindingVersion = version,+      canonicalType = canonical,+      equalityContract = Nothing,+      idDomainContract = Nothing,+      category = "structural"     }   where     (ownerModule, symbol) = splitQualified (unQualifiedValueName qualified)  nominalObligationsFor :: CheckedService -> ResolvedNominalType -> [BindingObligation]-nominalObligationsFor service nominal = case resolvedNominalOwnership nominal of+nominalObligationsFor service nominal = case (.ownership) nominal of   GeneratedNominal -> []   ConsumerNominal binding -> bindingEntry : fixtureEntry : initialEntries     where-      name = resolvedNominalName nominal-      source = consumerNominalHaskell binding-      consumerType = hsModule source <> "." <> hsType source-      paths = nominalUseSites spec name+      name = (.name) nominal+      source = (.haskell) binding+      consumerType = (.moduleName) source <> "." <> (.valueType) source+      paths = useSites spec name       registerPaths = [path | path <- paths, " register " `T.isInfixOf` path]-      category = case resolvedNominalRepresentation nominal of+      category = case (.representation) nominal of         IdRepresentation {} -> "nominal-id"         EnumRepresentation {} -> "nominal-enum"         ScalarRepresentation {} -> "nominal-scalar"-      representation = case resolvedNominalRepresentation nominal of+      representation = case (.representation) nominal of         IdRepresentation prefix -> "(KindID " <> quoted prefix <> ")"         EnumRepresentation {} -> nominalEnumRepresentationModule spec name <> "." <> name <> "Representation"         ScalarRepresentation NominalText -> "Text"@@ -314,14 +314,14 @@         ScalarRepresentation NominalNatural -> "Natural"         ScalarRepresentation NominalBool -> "Bool"         ScalarRepresentation NominalTime -> "UTCTime"-      canonical = Just (unCanonicalTypeId (consumerNominalCanonical binding))+      canonical = Just (unCanonicalTypeId ((.canonical) binding))       equalityContract = nominalEqualityIdentityForService (checkedLanguageContract service) nominal-      idContract = case resolvedNominalRepresentation nominal of+      idContract = case (.representation) nominal of         IdRepresentation prefix -> idDomainVersion <$> idDomainContractFor (checkedLanguageContract service) prefix         _ -> Nothing-      bindingEntry = nominalObligation name binding category (consumerNominalBinding binding) BindingValue ("NominalBinding " <> consumerType <> " " <> representation) paths (Just (unBindingVersion (consumerNominalBindingVersion binding))) canonical equalityContract idContract-      fixtureEntry = nominalObligation name binding category (consumerNominalFixtures binding) FixtureValue ("NominalFixtureCases " <> consumerType) paths Nothing canonical Nothing Nothing-      initialEntries = case (registerPaths, consumerNominalInitial binding) of+      bindingEntry = nominalObligation name binding category ((.binding) binding) BindingValue ("NominalBinding " <> consumerType <> " " <> representation) paths (Just (unBindingVersion ((.bindingVersion) binding))) canonical equalityContract idContract+      fixtureEntry = nominalObligation name binding category ((.fixtures) binding) FixtureValue ("NominalFixtureCases " <> consumerType) paths Nothing canonical Nothing Nothing+      initialEntries = case (registerPaths, (.initial) binding) of         ([], _) -> []         (_, Nothing) -> []         (_, Just initialValue) -> [nominalObligation name binding category initialValue InitialValue consumerType registerPaths Nothing canonical Nothing Nothing]@@ -332,61 +332,61 @@ nominalObligation :: Name -> ConsumerNominalBinding -> Text -> QualifiedValueName -> BindingObligationKind -> Text -> [Text] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> BindingObligation nominalObligation name binding category qualified kindValue signature paths version canonical equalityContract idDomainContract =   BindingObligation-    { obligationMappedName = name,-      obligationPackage = hsPackage (consumerNominalHaskell binding),-      obligationModule = ownerModule,-      obligationSymbol = symbol,-      obligationKind = kindValue,-      obligationSignature = symbol <> " :: " <> signature,-      obligationUseSites = paths,-      obligationBindingVersion = version,-      obligationCanonicalType = canonical,-      obligationEqualityContract = equalityContract,-      obligationIdDomainContract = idDomainContract,-      obligationCategory = category+    { mappedName = name,+      package = (.package) ((.haskell) binding),+      moduleName = ownerModule,+      symbol = symbol,+      kind = kindValue,+      signature = symbol <> " :: " <> signature,+      useSites = paths,+      bindingVersion = version,+      canonicalType = canonical,+      equalityContract = equalityContract,+      idDomainContract = idDomainContract,+      category = category     }   where     (ownerModule, symbol) = splitQualified (unQualifiedValueName qualified) -nominalUseSites :: Spec -> Name -> [Text]-nominalUseSites spec target = concatMap aggregatePaths [aggregate | NAggregate aggregate <- specNodes spec]+useSites :: Spec -> Name -> [Text]+useSites spec target = concatMap aggregatePaths [aggregate | NAggregate aggregate <- (.nodes) spec]   where     aggregatePaths aggregate =-      [ aggName aggregate <> " command " <> cmdName command <> " ." <> aggregateFieldName field <> " : " <> target-      | command <- aggCommands aggregate,-        field <- cmdFields command,+      [ (.name) aggregate <> " command " <> (.name) command <> " ." <> (.name) field <> " : " <> target+      | command <- (.commands) aggregate,+        field <- (.fields) command,         fieldUses field       ]-        <> [ aggName aggregate <> " event " <> evName event <> " ." <> aggregateFieldName field <> " : " <> target-           | event <- aggEvents aggregate,+        <> [ (.name) aggregate <> " event " <> (.name) event <> " ." <> (.name) field <> " : " <> target+           | event <- (.events) aggregate,              field <- eventFields aggregate event,              fieldUses field            ]-        <> [ aggName aggregate <> " register " <> regName register <> " : " <> target-           | register <- aggRegs aggregate,-             regType register == TRef target+        <> [ (.name) aggregate <> " register " <> (.name) register <> " : " <> target+           | register <- (.regs) aggregate,+             (.valueType) register == TRef target            ]-    eventFields aggregate event = case evBody event of+    eventFields aggregate event = case (.body) event of       EventFields fields -> fields-      EventFromCommand commandName -> concat [cmdFields command | command <- aggCommands aggregate, cmdName command == commandName]-    fieldUses field = aggregateFieldType field == Just (TRef target)+      EventFromCommand commandName -> concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName]+    fieldUses field = (.valueType) field == Just (TRef target)  nominalEnumRepresentationModule :: Spec -> Name -> Text-nominalEnumRepresentationModule spec name = case maybe GeneratedPrefix id (specLayout spec) of-  GeneratedPrefix -> root <> "Generated." <> contextName <> ".Nominal.Shape." <> name-  CollocatedLeaf -> root <> contextName <> ".Nominal.Shape." <> name <> ".Generated"+nominalEnumRepresentationModule spec nominalName = case maybe GeneratedPrefix id ((.layout) spec) of+  GeneratedPrefix -> root <> "Generated." <> contextModuleName <> ".Nominal.Shape." <> nominalName+  CollocatedLeaf -> root <> contextModuleName <> ".Nominal.Shape." <> nominalName <> ".Generated"   where-    root = maybe "" (<> ".") (specModuleRoot spec)-    contextName =+    root = maybe "" (<> ".") ((.moduleRoot) spec)+    contextModuleName =       case HaskellName.deriveHaskellName HaskellName.LogicalWireWord site of-        Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-        Left _ -> specContext spec+        Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)+        Left _ -> (.context) spec     site =       HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.ContextModuleSite,-          HaskellName.siteLogicalName = specContext spec,-          HaskellName.siteOwner = "binding-obligation-context",-          HaskellName.siteLine = 0+        { HaskellName.kind = HaskellName.ContextModuleSite,+          HaskellName.logicalName = (.context) spec,+          HaskellName.owner = "binding-obligation-context",+          HaskellName.line = 0         }  renderBindingObligations :: Text -> [BindingObligation] -> Text@@ -401,35 +401,35 @@     sameOwner left right = ownerKey left == ownerKey right     renderGroup [] = []     renderGroup entries@(firstEntry : _) =-      ("  " <> obligationModule firstEntry <> " (package " <> obligationPackage firstEntry <> ")")+      ("  " <> (.moduleName) firstEntry <> " (package " <> (.package) firstEntry <> ")")         : concatMap renderEntry entries     renderEntry obligation =-      [ "    " <> obligationSignature obligation,-        "      reason: " <> renderKind (obligationKind obligation) <> " — " <> obligationCategory obligation <> " type " <> obligationMappedName obligation <> renderPaths (obligationUseSites obligation)+      [ "    " <> (.signature) obligation,+        "      reason: " <> renderKind ((.kind) obligation) <> " — " <> (.category) obligation <> " type " <> (.mappedName) obligation <> renderPaths ((.useSites) obligation)       ]-        <> maybe [] (\version -> ["      provenance: binding-version " <> quoted version]) (obligationBindingVersion obligation)-        <> maybe [] (\canonical -> ["      canonical-type: " <> quoted canonical]) (obligationCanonicalType obligation)-        <> maybe [] (\contract -> ["      equality-contract: " <> quoted contract]) (obligationEqualityContract obligation)-        <> maybe [] (\contract -> ["      id-domain-contract: " <> quoted contract]) (obligationIdDomainContract obligation)+        <> maybe [] (\version -> ["      provenance: binding-version " <> quoted version]) ((.bindingVersion) obligation)+        <> maybe [] (\canonical -> ["      canonical-type: " <> quoted canonical]) ((.canonicalType) obligation)+        <> maybe [] (\contract -> ["      equality-contract: " <> quoted contract]) ((.equalityContract) obligation)+        <> maybe [] (\contract -> ["      id-domain-contract: " <> quoted contract]) ((.idDomainContract) obligation)     renderPaths [] = " (not currently used by an aggregate root)"     renderPaths paths = " (" <> T.intercalate "; " paths <> ")"     quoted value = T.pack (show value)  obligationSortKey :: BindingObligation -> (Text, Text, Text, BindingObligationKind, Text) obligationSortKey obligation =-  ( obligationPackage obligation,-    obligationModule obligation,-    obligationMappedName obligation,-    obligationKind obligation,-    obligationSymbol obligation+  ( (.package) obligation,+    (.moduleName) obligation,+    (.mappedName) obligation,+    (.kind) obligation,+    (.symbol) obligation   )  ownerKey :: BindingObligation -> (Text, Text)-ownerKey obligation = (obligationPackage obligation, obligationModule obligation)+ownerKey obligation = ((.package) obligation, (.moduleName) obligation)  holeSortKey :: BindingHole -> (Text, Name, BindingObligationKind, Maybe Text, Text) holeSortKey hole =-  (holeModule hole, holeMappedName hole, holeKind hole, holePath hole, holeSymbol hole)+  ((.moduleName) hole, (.mappedName) hole, (.kind) hole, (.path) hole, (.symbol) hole)  renderKind :: BindingObligationKind -> Text renderKind BindingValue = "binding"

src/Keiro/Dsl/Expression.hs view

@@ -42,11 +42,11 @@ import Keiro.Dsl.TypeGraph  data ExpressionEnvironment = ExpressionEnvironment-  { environmentSpec :: !Spec,-    environmentAggregate :: !Aggregate,-    environmentTransition :: !Transition,-    environmentSymbols :: !AggregateSymbols,-    environmentTypeGraph :: !(Maybe TypeGraph)+  { spec :: !Spec,+    aggregate :: !Aggregate,+    transition :: !Transition,+    symbols :: !AggregateSymbols,+    typeGraph :: !(Maybe TypeGraph)   }  expressionEnvironment :: Spec -> Aggregate -> Transition -> ExpressionEnvironment@@ -67,11 +67,11 @@ expressionEnvironmentWith :: AggregateSymbols -> Maybe TypeGraph -> Spec -> Aggregate -> Transition -> ExpressionEnvironment expressionEnvironmentWith symbols graph spec aggregate transition =   ExpressionEnvironment-    { environmentSpec = spec,-      environmentAggregate = aggregate,-      environmentTransition = transition,-      environmentSymbols = symbols,-      environmentTypeGraph = graph+    { spec = spec,+      aggregate = aggregate,+      transition = transition,+      symbols = symbols,+      typeGraph = graph     }  data ExpectedScalarType@@ -85,9 +85,9 @@   deriving stock (Eq, Show)  data ResolvedScalarProjection = ResolvedScalarProjection-  { scalarProjectionOwner :: !MappedKey,-    scalarProjectionPointer :: !Text,-    scalarProjectionFields :: ![Name]+  { owner :: !MappedKey,+    pointer :: !Text,+    fields :: ![Name]   }   deriving stock (Eq, Show) @@ -122,9 +122,9 @@   deriving stock (Eq, Show)  data TypedScalarExpr = TypedScalarExpr-  { typedScalarType :: !ResolvedAggregateType,-    typedScalarLoc :: !Loc,-    typedScalarNode :: !TypedScalarNode+  { valueType :: !ResolvedAggregateType,+    loc :: !Loc,+    node :: !TypedScalarNode   }   deriving stock (Eq, Show) @@ -144,9 +144,9 @@   deriving stock (Eq, Ord, Show)  data ExpressionDiagnostic = ExpressionDiagnostic-  { expressionDiagnosticLoc :: !Loc,-    expressionDiagnosticCode :: !ExpressionDiagnosticCode,-    expressionDiagnosticMessage :: !Text+  { loc :: !Loc,+    code :: !ExpressionDiagnosticCode,+    message :: !Text   }   deriving stock (Eq, Show) @@ -170,9 +170,9 @@       (resolvedLeft, resolvedRight) <- resolveBoth (resolve left (ExpectScalarType AggregateBool)) (resolve right (ExpectScalarType AggregateBool))       pure         TypedScalarExpr-          { typedScalarType = AggregateBool,-            typedScalarLoc = expressionLoc left right,-            typedScalarNode = constructor resolvedLeft resolvedRight+          { valueType = AggregateBool,+            loc = expressionLoc left right,+            node = constructor resolvedLeft resolvedRight           }      resolveComparison operator left right = do@@ -181,9 +181,9 @@       requireComparisonCapability operator resolvedLeft       pure         TypedScalarExpr-          { typedScalarType = AggregateBool,-            typedScalarLoc = expressionLoc left right,-            typedScalarNode = case operator of+          { valueType = AggregateBool,+            loc = expressionLoc left right,+            node = case operator of               OpEq -> TypedEqual resolvedLeft resolvedRight               OpNeq -> TypedNotEqual resolvedLeft resolvedRight               OpLt -> TypedCompare OpLt resolvedLeft resolvedRight@@ -200,30 +200,30 @@         _ -> resolvePair left right       let (resolvedLeft, resolvedRight) = pair       requireSameType resolvedLeft resolvedRight-      evidence <- arithmeticEvidence loc (typedScalarType resolvedLeft)+      evidence <- arithmeticEvidence loc ((.valueType) resolvedLeft)       pure         TypedScalarExpr-          { typedScalarType = typedScalarType resolvedLeft,-            typedScalarLoc = loc,-            typedScalarNode = constructor evidence resolvedLeft resolvedRight+          { valueType = (.valueType) resolvedLeft,+            loc = loc,+            node = constructor evidence resolvedLeft resolvedRight           }      resolvePair left right       | contextualLiteral left && not (contextualLiteral right) = do           resolvedRight <- resolve right InferScalarType-          resolvedLeft <- resolve left (ExpectScalarType (typedScalarType resolvedRight))+          resolvedLeft <- resolve left (ExpectScalarType ((.valueType) resolvedRight))           pure (resolvedLeft, resolvedRight)       | contextualLiteral right && not (contextualLiteral left) = do           resolvedLeft <- resolve left InferScalarType-          resolvedRight <- resolve right (ExpectScalarType (typedScalarType resolvedLeft))+          resolvedRight <- resolve right (ExpectScalarType ((.valueType) resolvedLeft))           pure (resolvedLeft, resolvedRight)       | otherwise = case (resolve left InferScalarType, resolve right InferScalarType) of           (Right resolvedLeft, Right resolvedRight) -> Right (resolvedLeft, resolvedRight)           (Left _, Right resolvedRight) -> do-            resolvedLeft <- resolve left (ExpectScalarType (typedScalarType resolvedRight))+            resolvedLeft <- resolve left (ExpectScalarType ((.valueType) resolvedRight))             pure (resolvedLeft, resolvedRight)           (Right resolvedLeft, Left _) -> do-            resolvedRight <- resolve right (ExpectScalarType (typedScalarType resolvedLeft))+            resolvedRight <- resolve right (ExpectScalarType ((.valueType) resolvedLeft))             pure (resolvedLeft, resolvedRight)           (Left leftErrors, Left rightErrors) -> Left (leftErrors <> rightErrors) @@ -234,15 +234,15 @@       (_, Left errors) -> Left errors      requireSameType left right-      | typedScalarType left == typedScalarType right = Right ()+      | (.valueType) left == (.valueType) right = Right ()       | otherwise =           failure-            (typedScalarLoc right)+            ((.loc) right)             ScalarOperandTypeMismatch             ( "expression operands have different scalar types '"-                <> aggregateCanonicalName (typedScalarType left)+                <> aggregateCanonicalName ((.valueType) left)                 <> "' and '"-                <> aggregateCanonicalName (typedScalarType right)+                <> aggregateCanonicalName ((.valueType) right)                 <> "'; numeric coercion is not supported"             ) @@ -254,37 +254,37 @@             OpLe -> OrderingGuardUse             OpGt -> OrderingGuardUse             OpGe -> OrderingGuardUse-       in case aggregateCapability useSite (typedScalarType operand) of+       in case aggregateCapability useSite ((.valueType) operand) of             SolverVisible -> Right ()             OpaqueOnly -> unsupported useSite             Unsupported -> unsupported useSite       where         unsupported useSite =           failure-            (typedScalarLoc operand)+            ((.loc) operand)             ScalarOperatorUnsupported             ( renderUseSite useSite                 <> " is unsupported for scalar type '"-                <> aggregateCanonicalName (typedScalarType operand)+                <> aggregateCanonicalName ((.valueType) operand)                 <> "'"             )      checkExpected InferScalarType resolved = Right resolved     checkExpected (ExpectScalarType wanted) resolved-      | wanted == typedScalarType resolved = Right resolved+      | wanted == (.valueType) resolved = Right resolved       | wanted == AggregateBool =           failure-            (typedScalarLoc resolved)+            ((.loc) resolved)             ScalarBooleanOperandRequired-            ("Boolean expression requires Bool, found '" <> aggregateCanonicalName (typedScalarType resolved) <> "'")+            ("Boolean expression requires Bool, found '" <> aggregateCanonicalName ((.valueType) resolved) <> "'")       | otherwise =           failure-            (typedScalarLoc resolved)+            ((.loc) resolved)             ScalarOperandTypeMismatch             ( "expected scalar type '"                 <> aggregateCanonicalName wanted                 <> "', found '"-                <> aggregateCanonicalName (typedScalarType resolved)+                <> aggregateCanonicalName ((.valueType) resolved)                 <> "'"             ) @@ -292,14 +292,14 @@ resolveGuardExpr environment expression =   case resolveScalarExpr environment (ExpectScalarType AggregateBool) expression of     Left diagnostics-      | all ((== ScalarBooleanOperandRequired) . expressionDiagnosticCode) (NE.toList diagnostics) ->+      | all ((== ScalarBooleanOperandRequired) . (.code)) (NE.toList diagnostics) ->           Left             ( fmap                 ( \diagnostic ->-                    diagnostic-                      { expressionDiagnosticCode = ScalarGuardBoolRequired,-                        expressionDiagnosticMessage = "aggregate guard must resolve to Bool; " <> expressionDiagnosticMessage diagnostic-                      }+                    replaceExpressionDiagnostic+                      ScalarGuardBoolRequired+                      ("aggregate guard must resolve to Bool; " <> diagnostic.message)+                      diagnostic                 )                 diagnostics             )@@ -307,40 +307,48 @@  resolveWriteExpr :: ExpressionEnvironment -> Name -> Expr -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr resolveWriteExpr environment registerName expression =-  case find ((== registerName) . regName) (aggRegs (environmentAggregate environment)) of+  case find ((== registerName) . (.name)) ((.regs) ((.aggregate) environment)) of     Nothing ->       failure         (exprLoc expression)         ScalarWriteTargetUnknown         ("write target '" <> registerName <> "' is not an aggregate register")-    Just register -> case resolveAggregateType (environmentSymbols environment) (regLoc register) RegisterUse (regType register) of+    Just register -> case resolveAggregateType ((.symbols) environment) ((.loc) register) RegisterUse ((.valueType) register) of       Left _ -> Right unresolvedSentinel       Right expected -> case resolveScalarExpr environment (ExpectScalarType expected) expression of         Left diagnostics -> Left (fmap writeDiagnostic diagnostics)         Right resolved           | predicateValued resolved ->               failure-                (typedScalarLoc resolved)+                ((.loc) resolved)                 ScalarOperatorUnsupported                 "comparison and Boolean operators are guard predicates and cannot be written as scalar terms"           | otherwise -> Right resolved         where           writeDiagnostic diagnostic-            | expressionDiagnosticCode diagnostic == ScalarOperandTypeMismatch =-                diagnostic-                  { expressionDiagnosticCode = ScalarWriteTypeMismatch,-                    expressionDiagnosticMessage =-                      "write to register '"-                        <> registerName-                        <> "' has the wrong scalar type; "-                        <> expressionDiagnosticMessage diagnostic-                  }+            | (.code) diagnostic == ScalarOperandTypeMismatch =+                replaceExpressionDiagnostic+                  ScalarWriteTypeMismatch+                  ( "write to register '"+                      <> registerName+                      <> "' has the wrong scalar type; "+                      <> diagnostic.message+                  )+                  diagnostic             | otherwise = diagnostic   where     -- The aggregate type validator reports the primary type error first. This     -- value is never scaffolded because any error prevents generation.     unresolvedSentinel = TypedScalarExpr AggregateBool noLoc (TypedLiteral (ScalarBoolValue False)) +replaceExpressionDiagnostic :: ExpressionDiagnosticCode -> Text -> ExpressionDiagnostic -> ExpressionDiagnostic+replaceExpressionDiagnostic code message diagnostic =+  ExpressionDiagnostic+    { loc = diagnostic.loc,+      code,+      message+    }+ resolvePath :: ExpressionEnvironment -> Loc -> ExprRoot -> [Name] -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr resolvePath environment loc root path = case path of   [] -> failure loc ScalarRootUnknown "scalar path is empty"@@ -364,15 +372,15 @@     (Nothing, Just value) -> Right (commandRoot value)     (Nothing, Nothing) -> unknown   where-    aggregate = environmentAggregate environment-    transition = environmentTransition environment-    symbols = environmentSymbols environment-    register = find ((== name) . regName) (aggRegs aggregate)+    aggregate = (.aggregate) environment+    transition = (.transition) environment+    symbols = (.symbols) environment+    register = find ((== name) . (.name)) ((.regs) aggregate)     commandField = do-      command <- find ((== tCommand transition) . cmdName) (aggCommands aggregate)-      find ((== name) . aggregateFieldName) (cmdFields command)+      matchedCommand <- find ((== (.command) transition) . (.name)) ((.commands) aggregate)+      find ((== name) . (.name)) ((.fields) matchedCommand)     registerRoot value =-      ScalarRegisterRoot name (resolvedOrUnknown (resolveAggregateType symbols (regLoc value) RegisterUse (regType value)))+      ScalarRegisterRoot name (resolvedOrUnknown (resolveAggregateType symbols ((.loc) value) RegisterUse ((.valueType) value)))     commandRoot value =       ScalarCommandRoot name (resolvedOrUnknown (inferAggregateFieldType symbols aggregate CommandFieldUse value))     resolvedOrUnknown = either (const (AggregateMapped (MappedKey "<invalid>"))) id@@ -383,7 +391,7 @@         ( "scalar root '"             <> name             <> "' resolves to no register or field of command '"-            <> tCommand transition+            <> (.command) transition             <> "'; qualify enum values as Type.Constructor"         ) @@ -396,21 +404,21 @@         loc         ScalarPathInvalid         ("cannot project fields through scalar type '" <> aggregateCanonicalName other <> "'")-  graph <- maybe (failure loc ScalarPathUnsupported "mapped structural graph is unavailable") Right (environmentTypeGraph environment)+  graph <- maybe (failure loc ScalarPathUnsupported "mapped structural graph is unavailable") Right ((.typeGraph) environment)   (resolvedType, wireKeys) <- walk graph owner fields   if scalarLeaf resolvedType     then       pure         TypedScalarExpr-          { typedScalarType = resolvedType,-            typedScalarLoc = loc,-            typedScalarNode =+          { valueType = resolvedType,+            loc = loc,+            node =               TypedProject                 provenance                 ResolvedScalarProjection-                  { scalarProjectionOwner = owner,-                    scalarProjectionPointer = T.concat ["/" <> escapePointer key | key <- wireKeys],-                    scalarProjectionFields = fields+                  { owner = owner,+                    pointer = T.concat ["/" <> escapePointer key | key <- wireKeys],+                    fields = fields                   }           }     else@@ -419,22 +427,22 @@         ScalarPathUnsupported         ("path ends at unsupported non-scalar type '" <> aggregateCanonicalName resolvedType <> "'")   where-    walk graph ownerKey remaining = case Map.lookup ownerKey (tgDeclarations graph) of+    walk graph ownerKey remaining = case Map.lookup ownerKey ((.declarations) graph) of       Just (ResolvedStructural _ (RRecord _ _ recordFields)) -> selectField graph recordFields remaining       Just ResolvedStructural {} -> failure loc ScalarPathUnsupported "scalar paths may cross required structural records only"       Just ResolvedOpaque {} -> failure loc ScalarPathUnsupported "scalar paths cannot cross an opaque mapped declaration"       Nothing -> failure loc ScalarPathInvalid ("unknown mapped path owner '" <> unMappedKey ownerKey <> "'")      selectField _ _ [] = failure loc ScalarPathInvalid "scalar path is empty"-    selectField graph recordFields (fieldName : rest) = case find ((== fieldName) . rwfHaskell) recordFields of-      Nothing -> failure loc ScalarPathInvalid ("required structural field '" <> fieldName <> "' does not exist")+    selectField graph recordFields (name : rest) = case find ((== name) . (.haskell)) recordFields of+      Nothing -> failure loc ScalarPathInvalid ("required structural field '" <> name <> "' does not exist")       Just field-        | rwfPresence field /= PRequired -> failure loc ScalarPathUnsupported ("field '" <> fieldName <> "' is optional; scalar paths must be total")-        | null rest -> (,[rwfKey field]) <$> resolvedLeaf (rwfType field)-        | RRef nextOwner <- rwfType field -> do+        | (.presence) field /= PRequired -> failure loc ScalarPathUnsupported ("field '" <> name <> "' is optional; scalar paths must be total")+        | null rest -> (,[(.key) field]) <$> resolvedLeaf ((.valueType) field)+        | RRef nextOwner <- (.valueType) field -> do             (leafType, keys) <- walk graph nextOwner rest-            pure (leafType, rwfKey field : keys)-        | otherwise -> failure loc ScalarPathUnsupported ("field '" <> fieldName <> "' is not a required structural record")+            pure (leafType, (.key) field : keys)+        | otherwise -> failure loc ScalarPathUnsupported ("field '" <> name <> "' is not a required structural record")      resolvedLeaf = \case       RText -> Right AggregateText@@ -482,17 +490,17 @@         (syntax <> " literal cannot inhabit scalar type '" <> aggregateCanonicalName other <> "'")  resolveEnumLiteral :: ExpressionEnvironment -> Loc -> ExpectedScalarType -> Name -> Name -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr-resolveEnumLiteral environment loc expected typeName constructor = case find ((== typeName) . enumName) (specEnums (environmentSpec environment)) of+resolveEnumLiteral environment loc expected typeName constructor = case find ((== typeName) . (.name)) ((.enums) ((.spec) environment)) of   Nothing -> failure loc ScalarLiteralInvalid ("unknown enum literal type '" <> typeName <> "'")   Just declaration-    | constructor `notElem` map fst (enumCtors declaration) ->+    | constructor `notElem` map fst ((.ctors) declaration) ->         failure loc ScalarLiteralInvalid ("enum '" <> typeName <> "' has no constructor '" <> constructor <> "'")     | otherwise -> do         resolved <- resolveDeclared typeName         requireExpected resolved         pure (literalExpr loc resolved (ScalarEnumValue typeName constructor))   where-    resolveDeclared name = case resolveAggregateType (environmentSymbols environment) loc WholeValueWriteUse (TRef name) of+    resolveDeclared name = case resolveAggregateType ((.symbols) environment) loc WholeValueWriteUse (TRef name) of       Left _ -> failure loc ScalarLiteralInvalid ("enum type '" <> name <> "' is not available at this aggregate use")       Right resolved -> Right resolved     requireExpected resolved = case expected of@@ -502,15 +510,15 @@         | otherwise -> failure loc ScalarOperandTypeMismatch ("enum literal has type '" <> aggregateCanonicalName resolved <> "', expected '" <> aggregateCanonicalName wanted <> "'")  resolveIdLiteral :: ExpressionEnvironment -> Loc -> ExpectedScalarType -> Name -> Text -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr-resolveIdLiteral environment loc expected typeName value = case find ((== typeName) . idName) (specIds (environmentSpec environment)) of+resolveIdLiteral environment loc expected typeName value = case find ((== typeName) . (.name)) ((.ids) ((.spec) environment)) of   Nothing -> failure loc ScalarLiteralInvalid ("unknown ID literal type '" <> typeName <> "'")   Just declaration -> case TypeID.parseText value of     Left parseError -> failure loc ScalarLiteralInvalid ("invalid " <> typeName <> " literal: " <> T.pack (show parseError))     Right parsed-      | TypeID.getPrefix parsed /= idPrefix declaration ->-          failure loc ScalarLiteralInvalid ("ID literal prefix must be '" <> idPrefix declaration <> "'")+      | TypeID.getPrefix parsed /= (.prefix) declaration ->+          failure loc ScalarLiteralInvalid ("ID literal prefix must be '" <> (.prefix) declaration <> "'")       | otherwise -> do-          resolved <- case resolveAggregateType (environmentSymbols environment) loc WholeValueWriteUse (TRef typeName) of+          resolved <- case resolveAggregateType ((.symbols) environment) loc WholeValueWriteUse (TRef typeName) of             Left _ -> failure loc ScalarLiteralInvalid ("ID type '" <> typeName <> "' is not available at this aggregate use")             Right valueType -> Right valueType           case expected of@@ -555,7 +563,7 @@   AggregateMapped {} -> False  predicateValued :: TypedScalarExpr -> Bool-predicateValued expression = case typedScalarNode expression of+predicateValued expression = case (.node) expression of   TypedEqual {} -> True   TypedNotEqual {} -> True   TypedCompare {} -> True@@ -599,9 +607,9 @@ failure loc diagnosticCode diagnosticMessage =   Left     ( ExpressionDiagnostic-        { expressionDiagnosticLoc = loc,-          expressionDiagnosticCode = diagnosticCode,-          expressionDiagnosticMessage = diagnosticMessage+        { loc = loc,+          code = diagnosticCode,+          message = diagnosticMessage         }         :| []     )

src/Keiro/Dsl/FieldIdentity.hs view

@@ -15,27 +15,27 @@ import Keiro.Dsl.Grammar  data ResolvedFieldIdentity = ResolvedFieldIdentity-  { fieldDslName :: !Name,-    fieldSelector :: !Text,-    fieldWireKey :: !Text,-    fieldLoc :: !Loc+  { dslName :: !Name,+    selector :: !Text,+    wireKey :: !Text,+    loc :: !Loc   }   deriving stock (Eq, Show)  resolveAggregateFieldIdentity :: AggregateField -> ResolvedFieldIdentity resolveAggregateFieldIdentity field =   ResolvedFieldIdentity-    { fieldDslName = aggregateFieldName field,-      fieldSelector = maybe (aggregateFieldName field) id (aggregateFieldSelector field),-      fieldWireKey = maybe (aggregateFieldName field) id (aggregateFieldWireKey field),-      fieldLoc = aggregateFieldLoc field+    { dslName = (.name) field,+      selector = maybe ((.name) field) id ((.selector) field),+      wireKey = maybe ((.name) field) id ((.wireKey) field),+      loc = (.loc) field     }  resolveContractFieldIdentity :: ContractField -> ResolvedFieldIdentity resolveContractFieldIdentity field =   ResolvedFieldIdentity-    { fieldDslName = cfName field,-      fieldSelector = maybe (cfName field) id (cfSelector field),-      fieldWireKey = maybe (cfName field) id (cfWireKey field),-      fieldLoc = cfLoc field+    { dslName = (.name) field,+      selector = maybe ((.name) field) id ((.selector) field),+      wireKey = maybe ((.name) field) id ((.wireKey) field),+      loc = (.loc) field     }

src/Keiro/Dsl/FoldFingerprint.hs view

@@ -24,7 +24,7 @@ import Keiro.Dsl.Grammar import Keiro.Dsl.LanguageVersion (RuntimeCapability (NominalEqualityV2), runtimeProfileHasCapability) import Keiro.Dsl.NominalType-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedSpec, checkedTypeGraph, effectiveRuntimeProfile, runtimeSemanticsFingerprintSegments)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec, checkedTypeGraph, runtimeSemanticsFingerprintSegments) import Keiro.Dsl.TypeGraph  -- | A checked service can retain language provenance before semantic@@ -72,14 +72,14 @@   graph <- mapLeft (FoldTypeGraphResolutionFailed . showText) (checkedTypeGraph service)   let symbols = aggregateSymbolsFromGraph graph spec   nominalRegistry <- mapLeft (FoldNominalResolutionFailed . showText) (resolveNominalTypes spec)-  registerSegments <- traverse (registerSegment symbols) (aggRegs aggregate)+  registerSegments <- traverse (registerSegment symbols) ((.regs) aggregate)   equalityUses <- nominalEqualityUses graph service aggregate-  transitionSegments <- traverse (transitionSegment graph spec aggregate) (aggTransitions aggregate)+  transitionSegments <- traverse (transitionSegment graph spec aggregate) ((.transitions) aggregate)   pure     ( T.intercalate         "\n"         ( runtimeSemanticsFingerprintSegments (checkedLanguageContract service)-            ++ map stateSegment (aggStates aggregate)+            ++ map stateSegment ((.states) aggregate)             ++ registerSegments             ++ mappedRegisterSegments graph             ++ nominalSegments nominalRegistry@@ -92,20 +92,20 @@     spec = checkedSpec service     referencedRules =       [ rule-      | rule <- specRules spec,-        ruleName rule `Set.member` referencedRuleNames spec aggregate+      | rule <- (.rules) spec,+        (.name) rule `Set.member` referencedRuleNames spec aggregate       ]     mappedRegisterSegments graph =       [ mappedRegisterSegment graph declaration-      | register <- aggRegs aggregate,-        TRef typeName <- [regType register],-        Just declaration <- [Map.lookup (MappedKey typeName) (tgDeclarations graph)]+      | register <- (.regs) aggregate,+        TRef typeName <- [(.valueType) register],+        Just declaration <- [Map.lookup (MappedKey typeName) ((.declarations) graph)]       ]     nominalSegments registry =       [ nominalUseSegment useSite nominal binding       | (useSite, typeName) <- nominalUseNames aggregate,         Just nominal <- [lookupNominalType typeName registry],-        ConsumerNominal binding <- [resolvedNominalOwnership nominal]+        ConsumerNominal binding <- [(.ownership) nominal]       ]  -- | Equality representation belongs in the fold identity only when a guard@@ -114,26 +114,26 @@ -- retain the old fold fingerprint. nominalEqualityUses :: TypeGraph -> CheckedService -> Aggregate -> Either FoldSurfaceError (Set Text) nominalEqualityUses graph service aggregate =-  if runtimeProfileHasCapability (effectiveRuntimeProfile (checkedLanguageContract service)) NominalEqualityV2-    then fmap (Set.fromList . concat) (traverse transitionIdentities (aggTransitions aggregate))+  if runtimeProfileHasCapability ((.runtimeProfile) (checkedLanguageContract service)) NominalEqualityV2+    then fmap (Set.fromList . concat) (traverse transitionIdentities ((.transitions) aggregate))     else       Right         ( Set.fromList             [ identity-            | transition <- aggTransitions aggregate,-              guardSyntax <- maybeToList (tGuard transition),+            | transition <- (.transitions) aggregate,+              guardSyntax <- maybeToList ((.guard) transition),               Right guardExpression <- [resolveGuardExpr (expressionEnvironmentFromGraph graph spec aggregate transition) guardSyntax],               identity <- equalityIdentities (checkedLanguageContract service) guardExpression             ]         )   where     spec = checkedSpec service-    transitionIdentities transition = case tGuard transition of+    transitionIdentities transition = case (.guard) transition of       Nothing -> Right []       Just guardSyntax -> do         guardExpression <-           mapLeft-            (FoldGuardResolutionFailed (aggName aggregate) (tCommand transition) . showText)+            (FoldGuardResolutionFailed ((.name) aggregate) ((.command) transition) . showText)             (resolveGuardExpr (expressionEnvironmentFromGraph graph spec aggregate transition) guardSyntax)         pure (equalityIdentities (checkedLanguageContract service) guardExpression) @@ -141,14 +141,14 @@ equalityIdentities languageContract expression =   current <> children   where-    current = case typedScalarNode expression of+    current = case (.node) expression of       TypedEqual left _ -> equalityIdentity left       TypedNotEqual left _ -> equalityIdentity left       _ -> []-    equalityIdentity operand = case typedScalarType operand of+    equalityIdentity operand = case (.valueType) operand of       AggregateNominal nominal -> maybeToList (nominalEqualityIdentityForService languageContract nominal)       _ -> []-    children = case typedScalarNode expression of+    children = case (.node) expression of       TypedLiteral {} -> []       TypedRoot {} -> []       TypedProject {} -> []@@ -164,31 +164,31 @@  nominalUseNames :: Aggregate -> [(Text, Name)] nominalUseNames aggregate =-  [ ("register:" <> regName register, typeName)-  | register <- aggRegs aggregate,-    TRef typeName <- [regType register]+  [ ("register:" <> (.name) register, typeName)+  | register <- (.regs) aggregate,+    TRef typeName <- [(.valueType) register]   ]-    <> [ ("event:" <> evName event <> "." <> aggregateFieldName field, typeName)-       | event <- aggEvents aggregate,+    <> [ ("event:" <> (.name) event <> "." <> (.name) field, typeName)+       | event <- (.events) aggregate,          field <- eventFields event,-         TRef typeName <- maybe [] pure (aggregateFieldType field)+         TRef typeName <- maybe [] pure ((.valueType) field)        ]   where-    eventFields event = case evBody event of+    eventFields event = case (.body) event of       EventFields fields -> fields-      EventFromCommand commandName -> concat [cmdFields command | command <- aggCommands aggregate, cmdName command == commandName]+      EventFromCommand commandName -> concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName]  nominalUseSegment :: Text -> ResolvedNominalType -> ConsumerNominalBinding -> Text nominalUseSegment useSite nominal binding =   T.intercalate     "|"     [ "nominal-use:" <> useSite,-      "name=" <> resolvedNominalName nominal,-      "representation=" <> nominalRepresentationSegment (resolvedNominalRepresentation nominal),-      "canonical=" <> unCanonicalTypeId (consumerNominalCanonical binding),-      "binding=" <> unQualifiedValueName (consumerNominalBinding binding),-      "binding-version=" <> unBindingVersion (consumerNominalBindingVersion binding),-      "initial=" <> maybe "(none)" unQualifiedValueName (consumerNominalInitial binding)+      "name=" <> (.name) nominal,+      "representation=" <> nominalRepresentationSegment ((.representation) nominal),+      "canonical=" <> unCanonicalTypeId ((.canonical) binding),+      "binding=" <> unQualifiedValueName ((.binding) binding),+      "binding-version=" <> unBindingVersion ((.bindingVersion) binding),+      "initial=" <> maybe "(none)" unQualifiedValueName ((.initial) binding)     ]  nominalRepresentationSegment :: NominalRepresentation -> Text@@ -206,80 +206,80 @@ mappedRegisterSegment graph (ResolvedStructural declaration _) =   T.intercalate     "|"-    [ "mapped-register:" <> sdName declaration,-      "wire=" <> wireFingerprint graph (sdName declaration),-      "canonical=" <> unCanonicalTypeId (sdCanonical declaration),-      "binding=" <> unQualifiedValueName (sdBinding declaration),-      "binding-version=" <> unBindingVersion (sdBindingVersion declaration),-      "initial=" <> maybe "(missing)" unQualifiedValueName (sdInitial declaration)+    [ "mapped-register:" <> (.name) declaration,+      "wire=" <> wireFingerprint graph ((.name) declaration),+      "canonical=" <> unCanonicalTypeId ((.canonical) declaration),+      "binding=" <> unQualifiedValueName ((.binding) declaration),+      "binding-version=" <> unBindingVersion ((.bindingVersion) declaration),+      "initial=" <> maybe "(missing)" unQualifiedValueName ((.initial) declaration)     ] mappedRegisterSegment _ (ResolvedOpaque declaration) =   T.intercalate     "|"-    [ "mapped-register:" <> odName declaration,-      "codec=" <> unCodecIdentity (odCodecIdentity declaration),-      "codec-version=" <> unCodecVersion (odCodecVersion declaration),-      "initial=" <> maybe "(missing)" unQualifiedValueName (odInitial declaration)+    [ "mapped-register:" <> (.name) declaration,+      "codec=" <> unCodecIdentity ((.codecIdentity) declaration),+      "codec-version=" <> unCodecVersion ((.codecVersion) declaration),+      "initial=" <> maybe "(missing)" unQualifiedValueName ((.initial) declaration)     ]  stateSegment :: StateDecl -> Text stateSegment state =   "state:"-    <> stName state+    <> (.name) state     <> "|terminal="-    <> if stTerminal state then "true" else "false"+    <> if (.terminal) state then "true" else "false"  registerSegment :: AggregateSymbols -> RegDecl -> Either FoldSurfaceError Text registerSegment symbols register = do   resolvedType <-     mapLeft-      (FoldRegisterTypeResolutionFailed (regName register) . showText)-      (resolveAggregateType symbols (regLoc register) RegisterUse (regType register))+      (FoldRegisterTypeResolutionFailed ((.name) register) . showText)+      (resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register))   resolvedInitial <-     mapLeft-      (FoldRegisterInitialResolutionFailed (regName register) . showText)-      (resolveRegisterInitial symbols (regLoc register) resolvedType (regInitial register))+      (FoldRegisterInitialResolutionFailed ((.name) register) . showText)+      (resolveRegisterInitial symbols ((.loc) register) resolvedType ((.initial) register))   pure     ( "reg:"-        <> regName register+        <> (.name) register         <> ":"-        <> typeExprCanonicalName (regType register)+        <> typeExprCanonicalName ((.valueType) register)         <> "="         <> registerInitialCanonicalName resolvedInitial     )  transitionSegment :: TypeGraph -> Spec -> Aggregate -> Transition -> Either FoldSurfaceError Text transitionSegment graph spec aggregate transition = do-  outputOwnershipSegment <- case tImplementation transition of+  outputOwnershipSegment <- case (.implementation) transition of     LegacyHoleImplementation -> Right []     GeneratedImplementation -> fmap (pure . ("outputs=" <>) . T.intercalate ",") outputSegments     HoleImplementation -> fmap (pure . ("outputs=" <>) . T.intercalate ",") outputSegments   pure     ( T.intercalate         "|"-        ( [ "transition:" <> renderMode (tMode transition),-            tSource transition,-            tCommand transition+        ( [ "transition:" <> renderMode ((.mode) transition),+            (.source) transition,+            (.command) transition           ]             ++ implementationSegment-            ++ [ "guard=" <> maybe "" canonicalExpr (tGuard transition),-                 "writes=" <> T.intercalate ";" (map renderWrite (tWrites transition)),-                 "emits=" <> T.intercalate "," (tEmits transition)+            ++ [ "guard=" <> maybe "" canonicalExpr ((.guard) transition),+                 "writes=" <> T.intercalate ";" (map renderWrite ((.writes) transition)),+                 "emits=" <> T.intercalate "," ((.emits) transition)                ]             ++ outputOwnershipSegment-            ++ ["goto=" <> tGoto transition]+            ++ ["goto=" <> (.goto) transition]         )     )   where     renderWrite (registerName, expression) = registerName <> ":=" <> canonicalExpr expression-    outputSegments = traverse (uncurry outputSegment) (zip [1 ..] (tEmits transition))+    outputSegments = traverse (uncurry outputSegment) (zip [1 ..] ((.emits) transition))     outputSegment emitIndex eventName = do       mapping <-         mapLeft-          (FoldEventOutputResolutionFailed (aggName aggregate) (tCommand transition) eventName . showText)+          (FoldEventOutputResolutionFailed ((.name) aggregate) ((.command) transition) eventName . showText)           (eventOutputMappingFromGraph graph spec aggregate transition emitIndex eventName)       pure (eventName <> "=" <> eventOutputCanonical mapping)-    implementationSegment = case tImplementation transition of+    implementationSegment = case (.implementation) transition of       LegacyHoleImplementation -> []       GeneratedImplementation -> ["implementation=generated"]       HoleImplementation -> ["implementation=hole"]@@ -292,10 +292,10 @@ ruleSegment rule =   T.intercalate     "|"-    [ "rule:" <> ruleName rule,-      ruleDomain rule,-      ruleCodomain rule,-      "cases=" <> T.intercalate ";" (map renderCase (ruleCases rule))+    [ "rule:" <> (.name) rule,+      (.domain) rule,+      (.codomain) rule,+      "cases=" <> T.intercalate ";" (map renderCase ((.cases) rule))     ]   where     renderCase (constructorName, expression) = constructorName <> "=>" <> canonicalExpr expression@@ -303,20 +303,20 @@ referencedRuleNames :: Spec -> Aggregate -> Set Name referencedRuleNames spec aggregate = close directNames   where-    rules = specRules spec+    rules = (.rules) spec     directNames =       Set.unions         [ exprNames expression-        | transition <- aggTransitions aggregate,-          expression <- maybeToList (tGuard transition) ++ map snd (tWrites transition)+        | transition <- (.transitions) aggregate,+          expression <- maybeToList ((.guard) transition) ++ map snd ((.writes) transition)         ]     close names =       let expanded =             Set.unions               ( names-                  : [ Set.unions (map (exprNames . snd) (ruleCases rule))+                  : [ Set.unions (map (exprNames . snd) ((.cases) rule))                     | name <- Set.toList names,-                      Just rule <- [find ((== name) . ruleName) rules]+                      Just rule <- [find ((== name) . (.name)) rules]                     ]               )        in if expanded == names then names else close expanded

src/Keiro/Dsl/Frontend/Internal.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE NoFieldSelectors #-}- -- | Shared implementation behind the public frontend and parser compatibility -- facade. This module is intentionally not exposed by the package. module Keiro.Dsl.Frontend.Internal@@ -32,7 +30,7 @@ import GHC.Generics (Generic) import Keiro.Dsl.Grammar import Keiro.Dsl.LanguageVersion-  ( LanguageDefinition,+  ( LanguageDefinition (..),     LanguageFeature,     LanguageVersion,     ParseFailure (..),@@ -40,7 +38,6 @@     SourceLanguage,     SourceLanguageDiagnostic (..),     SourceLanguageErrorCode,-    definitionVersion,     languageSupportsFeature,     renderParseFailure,     sourceLanguageDiagnosticMessage,@@ -62,7 +59,7 @@   deriving stock (Eq, Show, Generic)  frontendLanguageVersion :: FrontendContext -> LanguageVersion-frontendLanguageVersion FrontendContext {definition} = definitionVersion definition+frontendLanguageVersion FrontendContext {definition} = (.version) definition  frontendSupportsFeature :: FrontendContext -> LanguageFeature -> Bool frontendSupportsFeature context feature = languageSupportsFeature (frontendLanguageVersion context) feature@@ -111,11 +108,11 @@ frontendFailureFromSourceDiagnostic phase span supportedOverride diagnostic =   FrontendFailure     { phase,-      code = SourceLanguageError (sourceLanguageErrorCode diagnostic),+      code = SourceLanguageError ((.errorCode) diagnostic),       span,       message = sourceLanguageDiagnosticMessage diagnostic,       expected = [],-      supportedVersions = fromMaybe (NE.toList (sourceLanguageSupportedVersions diagnostic)) supportedOverride,+      supportedVersions = fromMaybe (NE.toList ((.supportedVersions) diagnostic)) supportedOverride,       compatibility = SourceLanguageFailure diagnostic     } @@ -189,13 +186,13 @@       Right       ( exactSemanticSourceIndex           (case surfaceSource of SurfaceSource {source} -> source)-          (semanticSourceSubjects (parsedSpec parsedSource))+          (semanticSourceSubjects ((.spec) parsedSource))           (surfaceSourceEntries surfaceSource)       )   pure     ParsedSourceDocument-      { documentParsedSource = parsedSource,-        documentSourceIndex = sourceIndex+      { parsedSource = parsedSource,+        sourceIndex = sourceIndex       }  -- | Compatibility lowering for syntax-valid semantic graphs, including graphs@@ -206,8 +203,8 @@   validateSurfaceSource surfaceSource   pure     ParsedSource-      { parsedSourceLanguage = language,-        parsedSpec = lowerSpec locatedSpec+      { sourceLanguage = language,+        spec = lowerSpec locatedSpec       }  surfaceSourceEntries :: SurfaceSource -> [(SourceSubject, SourceSpan)]@@ -223,11 +220,11 @@       SurfaceExpression {} -> []  sourceIndexLoweringFailure :: SourceSpan -> SourceIndexFailure -> LoweringFailure-sourceIndexLoweringFailure fallback SourceIndexFailure {failureCode = indexCode, failureSpan, failureMessage} =+sourceIndexLoweringFailure fallback SourceIndexFailure {code = indexCode, span, message} =   LoweringFailure     { code = SemanticSourceIndexInvalid indexCode,-      span = maybe fallback id failureSpan,-      message = failureMessage+      span = maybe fallback id span,+      message = message     }  lowerSpec :: Located SurfaceSpec -> Spec@@ -235,22 +232,22 @@   Located     { value =         SurfaceSpec-          { context = Located {value = contextName},+          { context = Located {value = name},             moduleRoot,             layout,             items           }     } =     Spec-      { specContext = contextName,-        specModuleRoot = locatedValue <$> moduleRoot,-        specLayout = locatedValue <$> layout,-        specIds = [declaration | Located {span, value = SurfaceId value} <- items, let declaration = value {idLoc = spanLoc span}],-        specEnums = [declaration | Located {span, value = SurfaceEnum value} <- items, let declaration = value {enumLoc = spanLoc span}],-        specRules = [declaration | Located {span, value = SurfaceRule value} <- items, let declaration = value {ruleLoc = spanLoc span}],-        specNominalScalars = [declaration | Located {span, value = SurfaceNominalScalar value} <- items, let declaration = value {nominalScalarLoc = spanLoc span}],-        specMapped = [declaration | Located {span, value = SurfaceMapped value} <- items, let declaration = setMappedLoc (spanLoc span) value],-        specNodes = [node | Located {span, value = SurfaceNode value} <- items, let node = setNodeLoc (spanLoc span) value]+      { context = name,+        moduleRoot = locatedValue <$> moduleRoot,+        layout = locatedValue <$> layout,+        ids = [setIdLoc (spanLoc span) value | Located {span, value = SurfaceId value} <- items],+        enums = [setEnumLoc (spanLoc span) value | Located {span, value = SurfaceEnum value} <- items],+        rules = [setRuleLoc (spanLoc span) value | Located {span, value = SurfaceRule value} <- items],+        nominalScalars = [setNominalScalarLoc (spanLoc span) value | Located {span, value = SurfaceNominalScalar value} <- items],+        mapped = [declaration | Located {span, value = SurfaceMapped value} <- items, let declaration = setMappedLoc (spanLoc span) value],+        nodes = [node | Located {span, value = SurfaceNode value} <- items, let node = setNodeLoc (spanLoc span) value]       }  locatedValue :: Located a -> a@@ -259,64 +256,73 @@ spanLoc :: SourceSpan -> Loc spanLoc sourceSpan = Loc (startLine sourceSpan) +setIdLoc :: Loc -> IdDecl -> IdDecl+setIdLoc loc IdDecl {name, prefix, binding} = IdDecl {name, prefix, binding, loc}++setEnumLoc :: Loc -> EnumDecl -> EnumDecl+setEnumLoc loc EnumDecl {name, ctors, binding} = EnumDecl {name, ctors, binding, loc}++setRuleLoc :: Loc -> RuleDecl -> RuleDecl+setRuleLoc loc RuleDecl {name, domain, codomain, cases} = RuleDecl {name, domain, codomain, cases, loc}++setNominalScalarLoc :: Loc -> NominalScalarDecl -> NominalScalarDecl+setNominalScalarLoc loc NominalScalarDecl {name, representation, binding} =+  NominalScalarDecl {name, representation, binding, loc}+ setMappedLoc :: Loc -> MappedDecl -> MappedDecl-setMappedLoc loc value@MappedStructural {} = value {msLoc = loc}-setMappedLoc loc value@MappedOpaque {} = value {moLoc = loc}+setMappedLoc loc (MappedStructural name haskell binding bindingVersion canonical fixtures initial shape _) =+  MappedStructural name haskell binding bindingVersion canonical fixtures initial shape loc+setMappedLoc loc (MappedOpaque name haskell codecId codecVersion fixtures initial _) =+  MappedOpaque name haskell codecId codecVersion fixtures initial loc  setNodeLoc :: Loc -> Node -> Node setNodeLoc loc = \case-  NAggregate value -> NAggregate value {aggLoc = loc}-  NProcess value -> NProcess value {procLoc = loc}-  NRouter value -> NRouter value {rtLoc = loc}-  NContract value -> NContract value {ctrLoc = loc}-  NIntake value -> NIntake value {inkLoc = loc}-  NEmit value -> NEmit value {emLoc = loc}-  NPublisher value -> NPublisher value {pubLoc = loc}-  NWorkqueue value -> NWorkqueue value {wqLoc = loc}-  NPgmqDispatch value -> NPgmqDispatch value {pdLoc = loc}-  NReadModel value -> NReadModel value {rmLoc = loc}-  NProjectionTarget value -> NProjectionTarget value {ptLoc = loc}-  NRebuildGroup value -> NRebuildGroup value {rgLoc = loc}-  NProjectionRevision value -> NProjectionRevision value {prvLoc = loc}-  NExternalRead value -> NExternalRead value {erLoc = loc}-  NProjectionOwner value -> NProjectionOwner value {poLoc = loc}-  NWorkflow-    WorkflowNode-      { wfId,-        wfStable,-        wfInput,-        wfInputFields,-        wfOutput,-        wfIdField,-        wfIdVia,-        wfBody-      } ->-      NWorkflow-        WorkflowNode-          { wfId,-            wfStable,-            wfInput,-            wfInputFields,-            wfOutput,-            wfIdField,-            wfIdVia,-            wfBody,-            wfLoc = loc-          }-  NOperation value -> NOperation value {opLoc = loc}+  NAggregate (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot _) ->+    NAggregate (Aggregate name regs states commands events transitions domainOutcomeTypes domainOutcomeDuplicateLocs wire projection snapshot loc)+  NProcess (ProcessNode nodeId name input correlate saga target projections handle rejected poison timer _) ->+    NProcess (ProcessNode nodeId name input correlate saga target projections handle rejected poison timer loc)+  NRouter (RouterNode nodeId name input key resolve target projections dispatch rejected poison _) ->+    NRouter (RouterNode nodeId name input key resolve target projections dispatch rejected poison loc)+  NContract (ContractNode name schemaVersion discriminator topics events _) ->+    NContract (ContractNode name schemaVersion discriminator topics events loc)+  NIntake (IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition _) ->+    NIntake (IntakeNode name contract topic accept binds dedupeKey dedupePolicy persist decode disposition loc)+  NEmit (EmitNode name contract topic source key discriminant mapping skip messageId idempotencyKey _) ->+    NEmit (EmitNode name contract topic source key discriminant mapping skip messageId idempotencyKey loc)+  NPublisher (PublisherNode name emit ordering maxAttempts backoff outboxField _) ->+    NPublisher (PublisherNode name emit ordering maxAttempts backoff outboxField loc)+  NWorkqueue (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition _) ->+    NWorkqueue (WorkqueueNode name logical physical dlq table ordering groupKey provision payloadName payload maxRetries delay dlqOn disposition loc)+  NPgmqDispatch PgmqDispatchNode {name, sourceReadModel, sourceKey, fanoutBody, dedupKey, dedupReadModel, dedupReadModelField, dedupQueue, dedupQueueField, enqueueTo} ->+    NPgmqDispatch PgmqDispatchNode {name, sourceReadModel, sourceKey, fanoutBody, dedupKey, dedupReadModel, dedupReadModelField, dedupQueue, dedupQueueField, enqueueTo, loc}+  NReadModel (ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes _) ->+    NReadModel (ReadModelNode name table schema columns version shape freshness supply group observedTargets backingTarget queryTypes loc)+  NProjectionTarget ProjectionTargetNode {name, schema, table, reset, dependsOn} ->+    NProjectionTarget ProjectionTargetNode {name, schema, table, reset, dependsOn, loc}+  NRebuildGroup RebuildGroupNode {name, targets, order} ->+    NRebuildGroup RebuildGroupNode {name, targets, order, loc}+  NProjectionRevision (ProjectionRevisionNode name group targets _) ->+    NProjectionRevision (ProjectionRevisionNode name group targets loc)+  NExternalRead ExternalReadNode {name, version, queryModel, resultSchema, resultType, compatibleRevisions, surfaceGeneration} ->+    NExternalRead ExternalReadNode {name, version, queryModel, resultSchema, resultType, compatibleRevisions, surfaceGeneration, loc}+  NProjectionOwner ProjectionOwnerNode {name, sources, delivery, group, targets, order, subscription, dedup, checkpointOnMissing, replay} ->+    NProjectionOwner ProjectionOwnerNode {name, sources, delivery, group, targets, order, subscription, dedup, checkpointOnMissing, replay, loc}+  NWorkflow (WorkflowNode nodeId stable input inputFields output idField idVia body _) ->+    NWorkflow (WorkflowNode nodeId stable input inputFields output idField idVia body loc)+  NOperation (OperationNode name shape _) -> NOperation (OperationNode name shape loc)  validateSurfaceSource :: SurfaceSource -> Either LoweringFailure () validateSurfaceSource   SurfaceSource     { source = sourceName,       preamble,-      spec = Located {span = specSpan, value = surfaceSpec}+      spec = Located {span = specSpan, value = spec}     } = do     traverse_ (validateOwnedSpan sourceName) allSpans     traverse_ (validateContained specSpan) bodySpans-    validateOrder (surfaceItemSpans surfaceSpec)+    validateOrder (surfaceItemSpans spec)     where-      bodySpans = surfaceSpecSpans surfaceSpec+      bodySpans = surfaceSpecSpans spec       allSpans = specSpan : maybe [] (\Located {span} -> [span]) preamble <> bodySpans       validateOwnedSpan expected sourceSpan@SourceSpan {source}         | not (validSourceSpan sourceSpan) =

− src/Keiro/Dsl/GeneratedHaskellLanguage.hs

@@ -1,48 +0,0 @@--- | The Haskell language contract for overwriteable generated modules.------ The manifest and conformance build profile publish the shared baseline.--- Syntax outside that baseline must be requested through the closed extension--- type and rendered as a module-local pragma.-module Keiro.Dsl.GeneratedHaskellLanguage-  ( GeneratedHaskellExtension (..),-    generatedHaskellDefaultLanguage,-    generatedHaskellDefaultExtensions,-    renderGeneratedLanguagePragmas,-  )-where--import Data.List (nub, sort)-import Data.Text (Text)--data GeneratedHaskellExtension-  = ExtBlockArguments-  | ExtDeriveAnyClass-  | ExtDuplicateRecordFields-  | ExtOverloadedLabels-  | ExtOverloadedRecordDot-  | ExtQualifiedDo-  | ExtTemplateHaskell-  | ExtTypeFamilies-  deriving (Eq, Ord, Show)--generatedHaskellDefaultLanguage :: Text-generatedHaskellDefaultLanguage = "GHC2024"--generatedHaskellDefaultExtensions :: [Text]-generatedHaskellDefaultExtensions = ["OverloadedStrings"]--renderGeneratedLanguagePragmas :: [GeneratedHaskellExtension] -> [Text]-renderGeneratedLanguagePragmas = map renderPragma . sort . nub . map extensionName-  where-    renderPragma name = "{-# LANGUAGE " <> name <> " #-}"--extensionName :: GeneratedHaskellExtension -> Text-extensionName extension = case extension of-  ExtBlockArguments -> "BlockArguments"-  ExtDeriveAnyClass -> "DeriveAnyClass"-  ExtDuplicateRecordFields -> "DuplicateRecordFields"-  ExtOverloadedLabels -> "OverloadedLabels"-  ExtOverloadedRecordDot -> "OverloadedRecordDot"-  ExtQualifiedDo -> "QualifiedDo"-  ExtTemplateHaskell -> "TemplateHaskell"-  ExtTypeFamilies -> "TypeFamilies"

src/Keiro/Dsl/Goldens.hs view

@@ -27,7 +27,7 @@ import Data.Text.IO qualified as TIO import Data.Text.Lazy qualified as TL import Keiro.Dsl.AggregateType-import Keiro.Dsl.FieldIdentity (fieldWireKey)+import Keiro.Dsl.FieldIdentity (ResolvedFieldIdentity (..)) import Keiro.Dsl.Grammar import Keiro.Dsl.NominalType import Keiro.Dsl.Scaffold (Agg (..), ResolvedCtor (..), defaultContext, resolveAgg)@@ -39,12 +39,12 @@   deriving stock (Eq, Show)  data GoldenPayload = GoldenPayload-  { goldenContext :: !Text,-    goldenAggregate :: !Text,-    goldenEvent :: !Text,-    goldenVersion :: !Int,-    goldenJson :: !Text,-    goldenEvidence :: !GoldenEvidence+  { context :: !Text,+    aggregate :: !Text,+    event :: !Text,+    version :: !Int,+    json :: !Text,+    evidence :: !GoldenEvidence   }   deriving stock (Eq, Show) @@ -53,23 +53,23 @@ goldensForDiff :: Spec -> Spec -> [GoldenPayload] goldensForDiff oldSpec newSpec =   [ GoldenPayload-      { goldenContext = specContext oldSpec,-        goldenAggregate = aggName oldAggregate,-        goldenEvent = evName oldEvent,-        goldenVersion = evVersion oldEvent,-        goldenJson = renderGolden oldSpec oldResolved oldResolvedEvent,-        goldenEvidence = SynthesizedWeakStandIn+      { context = (.context) oldSpec,+        aggregate = (.name) oldAggregate,+        event = (.name) oldEvent,+        version = (.version) oldEvent,+        json = renderGolden oldSpec oldResolved oldResolvedEvent,+        evidence = SynthesizedWeakStandIn       }   | oldAggregate <- aggregates oldSpec,-    Just newAggregate <- [find ((== aggName oldAggregate) . aggName) (aggregates newSpec)],-    let oldResolved = resolveAgg (defaultContext (specContext oldSpec)) oldSpec oldAggregate,-    oldEvent <- aggEvents oldAggregate,-    Just newEvent <- [find ((== evName oldEvent) . evName) (aggEvents newAggregate)],-    evVersion newEvent > evVersion oldEvent,-    Just oldResolvedEvent <- [find ((== evName oldEvent) . rcName) (aEvents oldResolved)]+    Just newAggregate <- [find ((== (.name) oldAggregate) . (.name)) (aggregates newSpec)],+    let oldResolved = resolveAgg (defaultContext ((.context) oldSpec)) oldSpec oldAggregate,+    oldEvent <- (.events) oldAggregate,+    Just newEvent <- [find ((== (.name) oldEvent) . (.name)) ((.events) newAggregate)],+    (.version) newEvent > (.version) oldEvent,+    Just oldResolvedEvent <- [find ((== (.name) oldEvent) . (.name)) ((.events) oldResolved)]   ]   where-    aggregates spec = [aggregate | NAggregate aggregate <- specNodes spec]+    aggregates spec = [aggregate | NAggregate aggregate <- (.nodes) spec]  -- | Write newly synthesized fixtures below -- @<root>/<context>/<aggregate>/<event>.v<version>.json@. Existing files are@@ -85,62 +85,72 @@         then pure []         else do           createDirectoryIfMissing True (takeDirectory path)-          TIO.writeFile path (goldenJson golden)+          TIO.writeFile path ((.json) golden)           pure [path]  -- | Load only the fixtures relevant to declared upcasters in @spec@. -- @root@ may name the global golden root or its context child directory. loadGoldenPayloads :: FilePath -> Spec -> IO [GoldenPayload] loadGoldenPayloads root spec = do-  contextRoot <- resolveContextRoot root (T.unpack (specContext spec))+  contextRoot <- resolveContextRoot root (T.unpack ((.context) spec))   fmap concat . traverse (loadAggregate contextRoot) $ aggregates spec   where-    aggregates current = [aggregate | NAggregate aggregate <- specNodes current]+    aggregates current = [aggregate | NAggregate aggregate <- (.nodes) current]      loadAggregate contextRoot aggregate =-      fmap concat . traverse (loadEvent contextRoot aggregate) $ aggEvents aggregate+      fmap concat . traverse (loadEvent contextRoot aggregate) $ (.events) aggregate -    loadEvent contextRoot aggregate event = case evUpcastFrom event of+    loadEvent contextRoot aggregate event = case (.upcastFrom) event of       Nothing -> pure []       Just (sourceVersion, _) -> do         let golden =               GoldenPayload-                { goldenContext = specContext spec,-                  goldenAggregate = aggName aggregate,-                  goldenEvent = evName event,-                  goldenVersion = sourceVersion,-                  goldenJson = "",-                  goldenEvidence = FileOwnedFixture+                { context = (.context) spec,+                  aggregate = (.name) aggregate,+                  event = (.name) event,+                  version = sourceVersion,+                  json = "",+                  evidence = FileOwnedFixture                 }             path = contextRoot </> aggregateRelativePath golden         exists <- doesFileExist path         if exists           then do             contents <- TIO.readFile path-            pure [golden {goldenJson = contents}]+            pure [goldenWithJson contents golden]           else pure [] +    goldenWithJson json golden =+      GoldenPayload+        { context = golden.context,+          aggregate = golden.aggregate,+          event = golden.event,+          version = golden.version,+          json,+          evidence = golden.evidence+        }+ goldenRelativePath :: GoldenPayload -> FilePath goldenRelativePath golden =-  T.unpack (goldenContext golden) </> aggregateRelativePath golden+  T.unpack ((.context) golden) </> aggregateRelativePath golden  aggregateRelativePath :: GoldenPayload -> FilePath aggregateRelativePath golden =-  T.unpack (goldenAggregate golden)-    </> T.unpack (goldenEvent golden)+  T.unpack ((.aggregate) golden)+    </> T.unpack ((.event) golden)       <> ".v"-      <> show (goldenVersion golden)+      <> show ((.version) golden)       <> ".json"  resolveContextRoot :: FilePath -> FilePath -> IO FilePath-resolveContextRoot root contextName = do-  let nested = root </> contextName+resolveContextRoot root name = do+  let nested = root </> name   nestedExists <- doesDirectoryExist nested   pure $     if nestedExists       then nested       else-        if takeFileName (dropTrailingPathSeparator root) == contextName+        if takeFileName (dropTrailingPathSeparator root) == name           then root           else nested @@ -150,13 +160,13 @@   where     graph = either (const Nothing) Just (resolveTypeGraph spec)     entries =-      (Key.fromText "kind", String (rcName event))-        : [(Key.fromText (fieldWireKey identity), sampleValue graph spec aggregate fieldType) | (identity, fieldType) <- rcFields event]+      (Key.fromText "kind", String ((.name) event))+        : [(Key.fromText ((.wireKey) identity), sampleValue graph spec aggregate valueType) | (identity, valueType) <- (.fields) event]  sampleValue :: Maybe TypeGraph -> Spec -> Agg -> ResolvedAggregateType -> Value sampleValue graph spec _aggregate resolvedType =   case resolvedType of-    AggregateNominal nominal -> case resolvedNominalRepresentation nominal of+    AggregateNominal nominal -> case (.representation) nominal of       IdRepresentation prefix -> String (prefix <> "_01hzy3v7q2e8kaw2m5x0d41n9c")       EnumRepresentation constructors -> String (snd (NE.head constructors))       ScalarRepresentation NominalText -> String "sample"@@ -168,15 +178,15 @@       String         ( fromMaybe             "sample"-            ( stName-                <$> ( find ((== vertexType) . (<> "Vertex") . aggName) aggregates-                        >>= listToMaybe . aggStates+            ( (.name)+                <$> ( find ((== vertexType) . (<> "Vertex") . (.name)) aggregates+                        >>= listToMaybe . (.states)                     )             )         )     AggregateMapped key       | Just resolved <- graph,-        Just declaration <- Map.lookup key (tgDeclarations resolved) ->+        Just declaration <- Map.lookup key ((.declarations) resolved) ->           sampleMappedDeclaration resolved declaration       | otherwise -> emptyObject     AggregateInt -> Number 1@@ -186,7 +196,7 @@     AggregateTime -> String "2026-01-02T03:04:05.123456789012Z"     AggregateText -> String "sample"   where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]  sampleMappedDeclaration :: TypeGraph -> ResolvedMappedDecl -> Value sampleMappedDeclaration graph =@@ -202,26 +212,26 @@     MappedShapeAlgebra       { onRecord = \_ _ fields ->           Object . KeyMap.fromList $-            [ (Key.fromText (rwfKey field), sampleMappedExpression graph (rwfType field))+            [ (Key.fromText ((.key) field), sampleMappedExpression graph ((.valueType) field))             | field <- fields,               includeField field             ],         onEnum = \entries -> case entries of-          firstEntry : _ -> String (weTag firstEntry)+          firstEntry : _ -> String ((.tag) firstEntry)           [] -> String "sample",         onUnion = \encoding arms -> case arms of           firstArm : _ ->             Object . KeyMap.fromList $-              [(Key.fromText (ueTagField encoding), String (rwaTag firstArm))]-                <> [ (Key.fromText (ueContentsField encoding), sampleMappedExpression graph payload)-                   | payload <- maybeToList (rwaPayload firstArm)+              [(Key.fromText ((.tagField) encoding), String ((.tag) firstArm))]+                <> [ (Key.fromText ((.contentsField) encoding), sampleMappedExpression graph payload)+                   | payload <- maybeToList ((.payload) firstArm)                    ]           [] -> emptyObject       }   where-    includeField field = case rwfPresence field of+    includeField field = case (.presence) field of       PRequired -> True-      POptional -> isNothingValue (rwfOnMissing field)+      POptional -> isNothingValue ((.onMissing) field)  sampleMappedExpression :: TypeGraph -> ResolvedTypeExpr -> Value sampleMappedExpression graph =@@ -237,7 +247,7 @@         onOptional = id,         onList = \value -> Array (pure value),         onMap = \value -> Object (KeyMap.singleton (Key.fromText "sample") value),-        onRef = \key -> maybe emptyObject (sampleMappedDeclaration graph) (Map.lookup key (tgDeclarations graph))+        onRef = \key -> maybe emptyObject (sampleMappedDeclaration graph) (Map.lookup key ((.declarations) graph))       }  emptyObject :: Value

src/Keiro/Dsl/Grammar.hs view

@@ -7,6 +7,7 @@   ( -- * Names and source locations     Name,     Loc (..),+    unLoc,     noLoc,      -- * Shared declarations@@ -187,6 +188,9 @@ newtype Loc = Loc {unLoc :: Int}   deriving stock (Show) +unLoc :: Loc -> Int+unLoc (Loc value) = value+ instance Eq Loc where   _ == _ = True @@ -197,20 +201,20 @@ -- | @id TransferReservationId prefix=rsv@ — declares an id newtype over 'Text' -- and its prefix tag. data IdDecl = IdDecl-  { idName :: !Name,-    idPrefix :: !Text,-    idBinding :: !(Maybe NominalBindingDecl),-    idLoc :: !Loc+  { name :: !Name,+    prefix :: !Text,+    binding :: !(Maybe NominalBindingDecl),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | @enum PatientAcuity { RedTag=red … }@ — a closed enumeration; each -- constructor carries its wire spelling (the right-hand side of @=@). data EnumDecl = EnumDecl-  { enumName :: !Name,-    enumCtors :: ![(Name, Text)],-    enumBinding :: !(Maybe NominalBindingDecl),-    enumLoc :: !Loc+  { name :: !Name,+    ctors :: ![(Name, Text)],+    binding :: !(Maybe NominalBindingDecl),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -218,11 +222,11 @@ -- @Ctor => bool ; …@ — a total function from an enum to a value, used as a -- derived atom inside guards. data RuleDecl = RuleDecl-  { ruleName :: !Name,-    ruleDomain :: !Name,-    ruleCodomain :: !Name,-    ruleCases :: ![(Name, Expr)],-    ruleLoc :: !Loc+  { name :: !Name,+    domain :: !Name,+    codomain :: !Name,+    cases :: ![(Name, Expr)],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -262,37 +266,37 @@   deriving stock (Eq, Show, Generic)  data WireField = WireField-  { wfHaskell :: !Name,-    wfKey :: !Text,-    wfType :: !TypeExpr,-    wfPresence :: !Presence,-    wfOnMissing :: !(Maybe OnMissing),-    wfLoc :: !Loc+  { haskell :: !Name,+    key :: !Text,+    valueType :: !TypeExpr,+    presence :: !Presence,+    onMissing :: !(Maybe OnMissing),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  wireFieldLoc :: WireField -> Loc-wireFieldLoc WireField {wfLoc = loc} = loc+wireFieldLoc WireField {loc} = loc  data UnionEncoding = TaggedObject-  { ueTagField :: !Text,-    ueContentsField :: !Text,-    ueUnknownFields :: !UnknownFields+  { tagField :: !Text,+    contentsField :: !Text,+    unknownFields :: !UnknownFields   }   deriving stock (Eq, Show, Generic)  data WireEnum = WireEnum-  { weCtor :: !Name,-    weTag :: !Text,-    weLoc :: !Loc+  { ctor :: !Name,+    tag :: !Text,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  data WireArm = WireArm-  { waCtor :: !Name,-    waTag :: !Text,-    waPayload :: !(Maybe TypeExpr),-    waLoc :: !Loc+  { ctor :: !Name,+    tag :: !Text,+    payload :: !(Maybe TypeExpr),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -303,9 +307,9 @@   deriving stock (Eq, Show, Generic)  data HaskellSource = HaskellSource-  { hsPackage :: !Text,-    hsModule :: !Text,-    hsType :: !Name+  { package :: !Text,+    moduleName :: !Text,+    valueType :: !Name   }   deriving stock (Eq, Ord, Show, Generic) @@ -314,13 +318,13 @@ -- The fields remain optional only so validation can report every missing fact at -- the owning declaration. Downstream code consumes the checked nominal registry. data NominalBindingDecl = NominalBindingDecl-  { nominalHaskell :: !(Maybe HaskellSource),-    nominalBinding :: !(Maybe Text),-    nominalBindingVersion :: !(Maybe Text),-    nominalCanonicalType :: !(Maybe Text),-    nominalFixtures :: !(Maybe Text),-    nominalInitial :: !(Maybe Text),-    nominalLoc :: !Loc+  { haskell :: !(Maybe HaskellSource),+    binding :: !(Maybe Text),+    bindingVersion :: !(Maybe Text),+    canonicalType :: !(Maybe Text),+    fixtures :: !(Maybe Text),+    initial :: !(Maybe Text),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -329,10 +333,10 @@ -- The raw representation name is retained so @keiro-dsl check@ owns the stable -- unsupported-representation diagnostic instead of the low-level parser. data NominalScalarDecl = NominalScalarDecl-  { nominalScalarName :: !Name,-    nominalScalarRepresentation :: !Name,-    nominalScalarBinding :: !NominalBindingDecl,-    nominalScalarLoc :: !Loc+  { name :: !Name,+    representation :: !Name,+    binding :: !NominalBindingDecl,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -363,8 +367,8 @@ -- (e.g. an event name → projection status). @mapPartial@ records whether the -- spec author explicitly marked the table partial over its domain. data Mapping = Mapping-  { mapPairs :: ![(Name, Name)],-    mapPartial :: !Bool+  { pairs :: ![(Name, Name)],+    partial :: !Bool   }   deriving stock (Eq, Show, Generic) @@ -474,10 +478,10 @@   deriving stock (Eq, Show, Generic)  data RegDecl = RegDecl-  { regName :: !Name,-    regType :: !TypeExpr,-    regInitial :: !RegInitial,-    regLoc :: !Loc+  { name :: !Name,+    valueType :: !TypeExpr,+    initial :: !RegInitial,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -485,9 +489,9 @@ -- trailing @!@ (no outgoing transitions allowed). The first 'StateDecl' in an -- aggregate's list is its initial state. data StateDecl = StateDecl-  { stName :: !Name,-    stTerminal :: !Bool,-    stLoc :: !Loc+  { name :: !Name,+    terminal :: !Bool,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -498,27 +502,27 @@ -- the complete 'TypeExpr' grammar so semantic validation can reject unsupported -- direct shapes with a located diagnostic. data AggregateField = AggregateField-  { aggregateFieldName :: !Name,-    aggregateFieldSelector :: !(Maybe Name),-    aggregateFieldWireKey :: !(Maybe Text),-    aggregateFieldType :: !(Maybe TypeExpr),-    aggregateFieldLoc :: !Loc+  { name :: !Name,+    selector :: !(Maybe Name),+    wireKey :: !(Maybe Text),+    valueType :: !(Maybe TypeExpr),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | A generic field used by process and router nodes. Aggregate fields are -- kept separate so widening aggregate syntax does not widen those node families. data Field = Field-  { fieldName :: !Name,-    fieldType :: !(Maybe Name)+  { name :: !Name,+    valueType :: !(Maybe Name)   }   deriving stock (Eq, Show, Generic)  -- | @command Name { field … }@ — a command constructor. data Command = Command-  { cmdName :: !Name,-    cmdFields :: ![AggregateField],-    cmdLoc :: !Loc+  { name :: !Name,+    fields :: ![AggregateField],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -528,23 +532,23 @@ -- reproducing the EP-1 surface. These fields live on the shared 'Event' so every -- node family's events inherit schema-versioning for free. data Event = Event-  { evName :: !Name,-    evBody :: !EventBody,+  { name :: !Name,+    body :: !EventBody,     -- | The schema version of this event shape. Default 1; written @vN@ for N>1.-    evVersion :: !Int,+    version :: !Int,     -- | The source version this shape migrates /from/, paired with the upcaster     --     hole. @Just (n-1, …)@ for a @vN@ shape; 'Nothing' for v1.-    evUpcastFrom :: !(Maybe (Int, Hole)),+    upcastFrom :: !(Maybe (Int, Hole)),     -- | Retirement is in progress. The event must keep at least one live     --     emitting transition while operators terminalize or truncate affected     --     streams; cut over to @deprecated@ plus a replay-only emitting transition     --     afterwards.-    evRetiring :: !Bool,+    retiring :: !Bool,     -- | Retired from the write path (no live transition may @emit@ it) but     --     still decodable from the log. A replay-only emitting transition must remain     --     while live streams can still contain the event.-    evDeprecated :: !Bool,-    evLoc :: !Loc+    deprecated :: !Bool,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -584,19 +588,19 @@ -- | A transition @Src -- Command --> clauses@. Clauses may be written -- indentation-stacked or @;@-separated on one line. data Transition = Transition-  { tSource :: !Name,-    tCommand :: !Name,-    tImplementation :: !TransitionImplementation,-    tGuard :: !(Maybe Expr),-    tWrites :: ![(Name, Expr)],-    tEmits :: ![Name],-    tOutcome :: !(Maybe TransitionOutcome),+  { source :: !Name,+    command :: !Name,+    implementation :: !TransitionImplementation,+    guard :: !(Maybe Expr),+    writes :: ![(Name, Expr)],+    emits :: ![Name],+    outcome :: !(Maybe TransitionOutcome),     -- | Locations of clauses after the first. Invalid syntax is retained long     -- enough for semantic validation to emit stable located diagnostics.-    tOutcomeDuplicateLocs :: ![Loc],-    tGoto :: !Name,-    tMode :: !TransitionMode,-    tLoc :: !Loc+    outcomeDuplicateLocs :: ![Loc],+    goto :: !Name,+    mode :: !TransitionMode,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -624,20 +628,20 @@ -- | @wire kind=ctorName fields=camelCase schemaVersion=1@ — how events -- serialize. data WireSpec = WireSpec-  { wireKind :: !Text,-    wireFields :: !Text,-    wireSchemaVersion :: !Int+  { kind :: !Text,+    fields :: !Text,+    schemaVersion :: !Int   }   deriving stock (Eq, Show, Generic)  -- | @projection table consistency=… key=… status-map { … }@ — the read-model -- projection and its event→status 'Mapping' (hole-kind 3). data ProjectionSpec = ProjectionSpec-  { projTable :: !Name,-    projConsistency :: !(Maybe Consistency),-    projKey :: !Name,-    projStatusMap :: !(Maybe Mapping),-    projLoc :: !Loc+  { table :: !Name,+    consistency :: !(Maybe Consistency),+    key :: !Name,+    statusMap :: !(Maybe Mapping),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -650,30 +654,30 @@  -- | Snapshot policy plus the captured live state-codec identity. data SnapshotSpec = SnapshotSpec-  { snapPolicy :: !SnapPolicy,-    snapCodecVersion :: !Int,-    snapShapeHash :: !Text,-    snapLoc :: !Loc+  { policy :: !SnapPolicy,+    codecVersion :: !Int,+    shapeHash :: !Text,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | An @aggregate@ node: a consistency boundary whose state is rebuilt by -- replaying events. data Aggregate = Aggregate-  { aggName :: !Name,-    aggRegs :: ![RegDecl],-    aggStates :: ![StateDecl],-    aggCommands :: ![Command],-    aggEvents :: ![Event],-    aggTransitions :: ![Transition],-    aggDomainOutcomeTypes :: !(Maybe DomainOutcomeTypes),+  { name :: !Name,+    regs :: ![RegDecl],+    states :: ![StateDecl],+    commands :: ![Command],+    events :: ![Event],+    transitions :: ![Transition],+    domainOutcomeTypes :: !(Maybe DomainOutcomeTypes),     -- | Locations of declarations after the first; see     -- 'tOutcomeDuplicateLocs'.-    aggDomainOutcomeDuplicateLocs :: ![Loc],-    aggWire :: !(Maybe WireSpec),-    aggProjection :: !(Maybe ProjectionSpec),-    aggSnapshot :: !(Maybe SnapshotSpec),-    aggLoc :: !Loc+    domainOutcomeDuplicateLocs :: ![Loc],+    wire :: !(Maybe WireSpec),+    projection :: !(Maybe ProjectionSpec),+    snapshot :: !(Maybe SnapshotSpec),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -683,26 +687,26 @@ -- A bare field reuses the input field of the same name; @name=value@ binds it to -- an expression (kept as raw text, e.g. @timerId=timer.id@). data FieldBinding = FieldBinding-  { fbName :: !Name,-    fbValue :: !(Maybe Text)+  { name :: !Name,+    value :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic)  -- | @input SurgeInput { hospitalId … observedAt:Time }@ — the process's incoming -- event shape (one field must be a @:Time@ field used by the timer deadline). data InputDecl = InputDecl-  { inName :: !Name,-    inFields :: ![Field],-    inType :: !(Maybe TypeExpr),-    inLoc :: !Loc+  { name :: !Name,+    fields :: ![Field],+    valueType :: !(Maybe TypeExpr),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | @correlate input.hospitalId via idText@ — the correlation key (hole-kind 1 -- derivation + hole-kind 4 field-source). data CorrelateDecl = CorrelateDecl-  { corrField :: !Name,-    corrVia :: !Name+  { field :: !Name,+    via :: !Name   }   deriving stock (Eq, Show, Generic) @@ -710,8 +714,8 @@ -- the validated stream category used with @Keiro.Stream.entityStream@.  For a -- correlation id @c@, the saga stream is @<category>-<c>@. data SagaRef = SagaRef-  { sagaAgg :: !Name,-    sagaCategory :: !Text+  { agg :: !Name,+    category :: !Text   }   deriving stock (Eq, Show, Generic) @@ -737,30 +741,30 @@  -- | @dispatch Hospital\@input.hospitalId ActivateSurge { … } on-appended … on-duplicate … on-failed …@. data DispatchNode = DispatchNode-  { dispTarget :: !Name,-    dispKey :: !Text,-    dispCommand :: !Name,-    dispFields :: ![FieldBinding],-    dispDisposition :: !DispatchDisposition,-    dispLoc :: !Loc+  { target :: !Name,+    key :: !Text,+    command :: !Name,+    fields :: ![FieldBinding],+    disposition :: !DispatchDisposition,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | The @on <Input>@ reaction: a self-advance, zero or more dispatches, and a -- @schedule@ of the timer. data HandleNode = HandleNode-  { hOn :: !Name,-    hAdvance :: !AdvanceNode,-    hDispatch :: ![DispatchNode],-    hSchedule :: !Name+  { on :: !Name,+    advance :: !AdvanceNode,+    dispatch :: ![DispatchNode],+    schedule :: !Name   }   deriving stock (Eq, Show, Generic)  -- | A deterministic id derivation: @uuidv5 \"prefix:\" <> correlationId@. data IdExpr = IdExpr-  { ideStrategy :: !IdStrategy,-    idePrefix :: !Text,-    ideField :: !Name+  { strategy :: !IdStrategy,+    prefix :: !Text,+    field :: !Name   }   deriving stock (Eq, Show, Generic) @@ -771,8 +775,8 @@ -- There is no clock-sampling constructor, so the no-wall-clock rule holds by -- construction. data FireAtExpr = FireAtExpr-  { faField :: !Name,-    faWindow :: !Text+  { field :: !Name,+    window :: !Text   }   deriving stock (Eq, Show, Generic) @@ -792,26 +796,26 @@  -- | @fire dispatch Surge\@correlationId MarkSurgeTimerFired { … } fired-event-id … on-ok …@. data FireNode = FireNode-  { fireTarget :: !Name,-    fireKey :: !Text,-    fireCommand :: !Name,-    fireFields :: ![FieldBinding],-    fireFiredEventId :: !IdExpr,-    fireDisposition :: !FireDisposition+  { target :: !Name,+    key :: !Text,+    command :: !Name,+    fields :: ![FieldBinding],+    firedEventId :: !IdExpr,+    disposition :: !FireDisposition   }   deriving stock (Eq, Show, Generic)  -- | A nested @timer@ sub-node of a process. data TimerNode = TimerNode-  { tmName :: !Name,-    tmId :: !IdExpr,-    tmFireAt :: !FireAtExpr,-    tmPayload :: ![FieldBinding],-    tmFire :: !FireNode,-    tmDecodeUnknown :: !Name,-    tmMaxAttempts :: !Int,-    tmDeadLetter :: !Text,-    tmLoc :: !Loc+  { name :: !Name,+    id :: !IdExpr,+    fireAt :: !FireAtExpr,+    payload :: ![FieldBinding],+    fire :: !FireNode,+    decodeUnknown :: !Name,+    maxAttempts :: !Int,+    deadLetter :: !Text,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -823,19 +827,19 @@ -- (runtime-owned uuidv5), so it is implicit in the AST and always rendered. data ProcessNode = ProcessNode   { -- | The block identifier (@process HospitalSurge@), used for module names.-    procId :: !Name,+    id :: !Name,     -- | The define-once ProcessManager @name@ (@name \"hospital-surge\"@).-    procName :: !Text,-    procInput :: !InputDecl,-    procCorrelate :: !CorrelateDecl,-    procSaga :: !SagaRef,-    procTarget :: !Name,-    procProjections :: ![Name],-    procHandle :: !HandleNode,-    procRejected :: !PolicyChoice,-    procPoison :: !PolicyChoice,-    procTimer :: !TimerNode,-    procLoc :: !Loc+    name :: !Text,+    input :: !InputDecl,+    correlate :: !CorrelateDecl,+    saga :: !SagaRef,+    target :: !Name,+    projections :: ![Name],+    handle :: !HandleNode,+    rejected :: !PolicyChoice,+    poison :: !PolicyChoice,+    timer :: !TimerNode,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -852,30 +856,30 @@ -- Policy spellings that are not yet admitted remain raw names so validation, -- rather than parsing, owns stable diagnostics for future-looking values. data RouterSelectionDecl = RouterSelectionDecl-  { rsIdentity :: !Text,-    rsIdentityLoc :: !Loc,-    rsVersion :: !Natural,-    rsVersionLoc :: !Loc,-    rsQuery :: !Name,-    rsQueryLoc :: !Loc,-    rsQueryInput :: !Name,-    rsQueryInputLoc :: !Loc,-    rsPredicate :: !Expr,-    rsRecipient :: !Expr,-    rsLimit :: !(Maybe (Natural, Loc)),-    rsOrder :: !Name,-    rsOrderLoc :: !Loc,-    rsDedupe :: !Name,-    rsDedupeLoc :: !Loc,-    rsEmptyPolicy :: !SelectionDispositionSyntax,-    rsEmptyPolicyLoc :: !Loc,-    rsFailurePolicy :: !SelectionDispositionSyntax,-    rsFailurePolicyLoc :: !Loc,-    rsRedelivery :: !Name,-    rsRedeliveryLoc :: !Loc,-    rsPartial :: !Name,-    rsPartialLoc :: !Loc,-    rsLoc :: !Loc+  { identity :: !Text,+    identityLoc :: !Loc,+    version :: !Natural,+    versionLoc :: !Loc,+    query :: !Name,+    queryLoc :: !Loc,+    queryInput :: !Name,+    queryInputLoc :: !Loc,+    predicate :: !Expr,+    recipient :: !Expr,+    limit :: !(Maybe (Natural, Loc)),+    order :: !Name,+    orderLoc :: !Loc,+    dedupe :: !Name,+    dedupeLoc :: !Loc,+    emptyPolicy :: !SelectionDispositionSyntax,+    emptyPolicyLoc :: !Loc,+    failurePolicy :: !SelectionDispositionSyntax,+    failurePolicyLoc :: !Loc,+    redelivery :: !Name,+    redeliveryLoc :: !Loc,+    partial :: !Name,+    partialLoc :: !Loc,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -886,17 +890,17 @@   deriving stock (Eq, Show, Generic)  data ResolveDecl = ResolveDecl-  { rvSource :: !ResolveSource,-    rvRow :: ![Name],-    rvLoc :: !Loc+  { source :: !ResolveSource,+    row :: ![Name],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  data RouterDispatchNode = RouterDispatchNode-  { rdCommand :: !Name,-    rdFields :: ![FieldBinding],-    rdDisposition :: !DispatchDisposition,-    rdLoc :: !Loc+  { command :: !Name,+    fields :: ![FieldBinding],+    disposition :: !DispatchDisposition,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -904,17 +908,17 @@ -- the mandatory @stable@ token on the resolve clause is an author acknowledgement -- that retry attempts accumulate the union of resolved target identities. data RouterNode = RouterNode-  { rtId :: !Name,-    rtName :: !Text,-    rtInput :: !InputDecl,-    rtKey :: !CorrelateDecl,-    rtResolve :: !ResolveDecl,-    rtTarget :: !Name,-    rtProjections :: ![Name],-    rtDispatch :: !RouterDispatchNode,-    rtRejected :: !PolicyChoice,-    rtPoison :: !PolicyChoice,-    rtLoc :: !Loc+  { id :: !Name,+    name :: !Text,+    input :: !InputDecl,+    key :: !CorrelateDecl,+    resolve :: !ResolveDecl,+    target :: !Name,+    projections :: ![Name],+    dispatch :: !RouterDispatchNode,+    rejected :: !PolicyChoice,+    poison :: !PolicyChoice,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -925,19 +929,19 @@   deriving stock (Eq, Show, Generic)  data ContractField = ContractField-  { cfName :: !Name,-    cfSelector :: !(Maybe Name),-    cfWireKey :: !(Maybe Text),-    cfType :: !ContractType,-    cfLoc :: !Loc+  { name :: !Name,+    selector :: !(Maybe Name),+    wireKey :: !(Maybe Text),+    valueType :: !ContractType,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | @event <Name> on <topicAlias> { field: type … }@ within a contract. data ContractEvent = ContractEvent-  { ceName :: !Name,-    ceTopic :: !Name,-    ceFields :: ![ContractField]+  { name :: !Name,+    topic :: !Name,+    fields :: ![ContractField]   }   deriving stock (Eq, Show, Generic) @@ -945,13 +949,13 @@ -- and referenced by both producer (@emit@) and consumer (@intake@). EP-5's -- pgmq @dispatch@ also couples to it. data ContractNode = ContractNode-  { ctrName :: !Name,-    ctrSchemaVersion :: !Int,-    ctrDiscriminator :: !Name,+  { name :: !Name,+    schemaVersion :: !Int,+    discriminator :: !Name,     -- | (topic alias, real Kafka topic string)-    ctrTopics :: ![(Name, Text)],-    ctrEvents :: ![ContractEvent],-    ctrLoc :: !Loc+    topics :: ![(Name, Text)],+    events :: ![ContractEvent],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -967,10 +971,10 @@  -- | One envelope-binding row: @bind <field> from <source> [required] [cross-check body]@. data BindRow = BindRow-  { brField :: !Name,-    brSource :: !WireSource,-    brRequired :: !Bool,-    brCrossCheck :: !Bool+  { field :: !Name,+    source :: !WireSource,+    required :: !Bool,+    crossCheck :: !Bool   }   deriving stock (Eq, Show, Generic) @@ -986,18 +990,18 @@  -- | One row of the mandatory, complete inbox disposition table. data DispositionRow = DispositionRow-  { drOutcome :: !Name,-    drAction :: !InboxAction,-    drLoc :: !Loc+  { outcome :: !Name,+    action :: !InboxAction,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | The body decode-strictness decision (hole-kind 6). data DecodeSpec = DecodeSpec   { -- | the envelope policy text, e.g. @strict-required lenient-optional@-    decEnvelope :: !Text,-    decBodyStrict :: !Bool,-    decBodySchemaVersion :: !Int+    envelope :: !Text,+    bodyStrict :: !Bool,+    bodySchemaVersion :: !Int   }   deriving stock (Eq, Show, Generic) @@ -1009,17 +1013,17 @@ -- block (brokers/groupId/offsetReset) is hole-kind 8, delegated to deployment -- and not modelled here. data IntakeNode = IntakeNode-  { inkName :: !Name,-    inkContract :: !Name,-    inkTopic :: !Name,-    inkAccept :: ![Name],-    inkBinds :: ![BindRow],-    inkDedupeKey :: !Name,-    inkDedupePolicy :: !Name,-    inkPersist :: !InkPersist,-    inkDecode :: !DecodeSpec,-    inkDisposition :: ![DispositionRow],-    inkLoc :: !Loc+  { name :: !Name,+    contract :: !Name,+    topic :: !Name,+    accept :: ![Name],+    binds :: ![BindRow],+    dedupeKey :: !Name,+    dedupePolicy :: !Name,+    persist :: !InkPersist,+    decode :: !DecodeSpec,+    disposition :: ![DispositionRow],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1031,49 +1035,49 @@  -- | One @\"value\" => EventType@ row of an emit's status mapping. data EmitMapRow = EmitMapRow-  { emrValue :: !Text,-    emrEvent :: !Name,-    emrLoc :: !Loc+  { value :: !Text,+    event :: !Name,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | An @emit@ (outbox) node: maps a private status discriminant to contract -- event types, with a mandatory explicit @_ => skip@ catch-all. data EmitNode = EmitNode-  { emName :: !Name,-    emContract :: !Name,-    emTopic :: !Name,-    emSource :: !Text,-    emKey :: !Name,-    emDiscriminant :: !Name,-    emMap :: ![EmitMapRow],+  { name :: !Name,+    contract :: !Name,+    topic :: !Name,+    source :: !Text,+    key :: !Name,+    discriminant :: !Name,+    map :: ![EmitMapRow],     -- | whether the explicit @_ => skip@ catch-all is present-    emSkip :: !Bool,-    emMessageId :: !DeriveSpec,-    emIdempotencyKey :: !DeriveSpec,-    emLoc :: !Loc+    skip :: !Bool,+    messageId :: !DeriveSpec,+    idempotencyKey :: !DeriveSpec,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | @backoff <kind> <window>@, e.g. @backoff constant 2s@. data BackoffSpec = BackoffSpec-  { boKind :: !Name,-    boWindow :: !Text,-    boMax :: !(Maybe Text),-    boMultiplier :: !(Maybe Text)+  { kind :: !Name,+    window :: !Text,+    max :: !(Maybe Text),+    multiplier :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic)  -- | A @publisher@ node: the at-least-once publishing policy for an emit's topic. data PublisherNode = PublisherNode-  { pubName :: !Name,-    pubEmit :: !Name,-    pubOrdering :: !Name,-    pubMaxAttempts :: !Int,-    pubBackoff :: !BackoffSpec,+  { name :: !Name,+    emit :: !Name,+    ordering :: !Name,+    maxAttempts :: !Int,+    backoff :: !BackoffSpec,     -- | @outboxId stable from <field>@: retries coalesce on (source, this field)-    pubOutboxField :: !Name,-    pubLoc :: !Loc+    outboxField :: !Name,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1103,19 +1107,19 @@  -- | One @field -> \"wire_name\" type required@ row of a workqueue payload. data WqField = WqField-  { wqfName :: !Name,-    wqfWire :: !Text,-    wqfType :: !QueuePayloadType,-    wqfLoc :: !Loc+  { name :: !Name,+    wire :: !Text,+    valueType :: !QueuePayloadType,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | One row of a workqueue's consumer @JobOutcome@ disposition (reusing -- 'InboxAction': @retry <window>@ \/ @deadLetter@). data WqDispRow = WqDispRow-  { wqdOutcome :: !Name,-    wqdAction :: !InboxAction,-    wqdLoc :: !Loc+  { outcome :: !Name,+    action :: !InboxAction,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1125,9 +1129,9 @@  -- | A FIFO message-group key derived from one payload field. data WqGroupKey = WqGroupKey-  { gkField :: !Name,-    gkVia :: !Name,-    gkFixture :: !(Maybe Text)+  { field :: !Name,+    via :: !Name,+    fixture :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -1142,38 +1146,38 @@ -- /captured fixture/ (hole-kind 1): the validator re-derives the physical name -- from @logical@ and flags any divergence (the drift hazard at the dedup site). data WorkqueueNode = WorkqueueNode-  { wqName :: !Name,-    wqLogical :: !Text,-    wqPhysical :: !Text,-    wqDlq :: !Text,-    wqTable :: !Text,-    wqOrdering :: !WqOrdering,-    wqGroupKey :: !(Maybe WqGroupKey),-    wqProvision :: !WqProvision,-    wqPayloadName :: !Name,-    wqPayload :: ![WqField],-    wqMaxRetries :: !Int,-    wqDelay :: !Text,-    wqDlqOn :: !Bool,-    wqDisposition :: ![WqDispRow],-    wqLoc :: !Loc+  { name :: !Name,+    logical :: !Text,+    physical :: !Text,+    dlq :: !Text,+    table :: !Text,+    ordering :: !WqOrdering,+    groupKey :: !(Maybe WqGroupKey),+    provision :: !WqProvision,+    payloadName :: !Name,+    payload :: ![WqField],+    maxRetries :: !Int,+    delay :: !Text,+    dlqOn :: !Bool,+    disposition :: ![WqDispRow],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | A pgmq @dispatch@ node: a read-model→enqueue coupling with a fan-out hole -- and a dedup check (one arm of which is a raw-SQL hole). data PgmqDispatchNode = PgmqDispatchNode-  { pdName :: !Name,-    pdSourceReadModel :: !Name,-    pdSourceKey :: !Name,-    pdFanoutBody :: !Name,-    pdDedupKey :: !Name,-    pdDedupReadModel :: !Name,-    pdDedupReadModelField :: !Text,-    pdDedupQueue :: !Name,-    pdDedupQueueField :: !Text,-    pdEnqueueTo :: !Name,-    pdLoc :: !Loc+  { name :: !Name,+    sourceReadModel :: !Name,+    sourceKey :: !Name,+    fanoutBody :: !Name,+    dedupKey :: !Name,+    dedupReadModel :: !Name,+    dedupReadModelField :: !Text,+    dedupQueue :: !Name,+    dedupQueueField :: !Text,+    enqueueTo :: !Name,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1233,39 +1237,39 @@ -- | A registered, versioned SQL read model. Columns define its shape identity; -- the runtime table remains owned by codd migrations rather than the DSL. data ReadModelNode = ReadModelNode-  { rmName :: !Name,-    rmTable :: !Text,-    rmSchema :: !Text,-    rmColumns :: ![RmColumn],-    rmVersion :: !Int,-    rmShape :: !Text,-    rmFreshness :: !QueryFreshnessNode,-    rmSupply :: !ReadModelSupply,-    rmGroup :: !(Maybe Name),-    rmObservedTargets :: ![Name],-    rmBackingTarget :: !(Maybe Name),+  { name :: !Name,+    table :: !Text,+    schema :: !Text,+    columns :: ![RmColumn],+    version :: !Int,+    shape :: !Text,+    freshness :: !QueryFreshnessNode,+    supply :: !ReadModelSupply,+    group :: !(Maybe Name),+    observedTargets :: ![Name],+    backingTarget :: !(Maybe Name),     queryTypes :: !(Maybe ReadModelQueryTypes),-    rmLoc :: !Loc+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  legacyReadModelConsistency :: ReadModelNode -> Maybe Consistency-legacyReadModelConsistency readModel = case rmSupply readModel of+legacyReadModelConsistency readModel = case (.supply) readModel of   LegacyReadModelSupply {legacyConsistency} -> Just legacyConsistency   OwnerDerivedSupply -> Nothing  legacyReadModelScope :: ReadModelNode -> Maybe RmScope-legacyReadModelScope readModel = case rmSupply readModel of+legacyReadModelScope readModel = case (.supply) readModel of   LegacyReadModelSupply {legacyScope} -> legacyScope   OwnerDerivedSupply -> Nothing  legacyReadModelFeed :: ReadModelNode -> Maybe RmFeed-legacyReadModelFeed readModel = case rmSupply readModel of+legacyReadModelFeed readModel = case (.supply) readModel of   LegacyReadModelSupply {legacyFeed} -> Just legacyFeed   OwnerDerivedSupply -> Nothing  legacyReadModelSubscription :: ReadModelNode -> Maybe Text-legacyReadModelSubscription readModel = case rmSupply readModel of+legacyReadModelSubscription readModel = case (.supply) readModel of   LegacyReadModelSupply {legacySubscription} -> legacySubscription   OwnerDerivedSupply -> Nothing @@ -1276,21 +1280,21 @@  -- | One physical PostgreSQL target owned by exactly one catalog group. data ProjectionTargetNode = ProjectionTargetNode-  { ptName :: !Name,-    ptSchema :: !Text,-    ptTable :: !Text,-    ptReset :: !TargetResetPolicy,-    ptDependsOn :: ![Name],-    ptLoc :: !Loc+  { name :: !Name,+    schema :: !Text,+    table :: !Text,+    reset :: !TargetResetPolicy,+    dependsOn :: ![Name],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  -- | One atomic lifecycle group and its deterministic target preparation order. data RebuildGroupNode = RebuildGroupNode-  { rgName :: !Name,-    rgTargets :: ![Name],-    rgOrder :: ![Name],-    rgLoc :: !Loc+  { name :: !Name,+    targets :: ![Name],+    order :: ![Name],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1301,31 +1305,31 @@   deriving stock (Eq, Ord, Show, Generic)  data PromotionObjectNode = PromotionObjectNode-  { rpoKind :: !PromotionObjectKindNode,-    rpoGenerationName :: !Text,-    rpoCanonicalName :: !Text+  { kind :: !PromotionObjectKindNode,+    generationName :: !Text,+    canonicalName :: !Text   }   deriving stock (Eq, Show, Generic)  -- | Application-owned schema contract for one target in a projection -- revision. The DSL carries stable identities, never raw DDL. data RevisionTargetNode = RevisionTargetNode-  { prtTarget :: !Name,-    prtSchemaVersion :: !Text,-    prtProvisioner :: !Text,-    prtProvisionerVersion :: !Int,-    prtExpectedShape :: !Text,-    prtValidator :: !Text,-    prtValidatorVersion :: !Int,-    prtPromotionObjects :: ![PromotionObjectNode]+  { target :: !Name,+    schemaVersion :: !Text,+    provisioner :: !Text,+    provisionerVersion :: !Int,+    expectedShape :: !Text,+    validator :: !Text,+    validatorVersion :: !Int,+    promotionObjects :: ![PromotionObjectNode]   }   deriving stock (Eq, Show, Generic)  data ProjectionRevisionNode = ProjectionRevisionNode-  { prvName :: !Name,-    prvGroup :: !Name,-    prvTargets :: ![RevisionTargetNode],-    prvLoc :: !Loc+  { name :: !Name,+    group :: !Name,+    targets :: ![RevisionTargetNode],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1333,14 +1337,14 @@ -- contract. The result shape is deliberately absent: lowering obtains it from -- the checked read-model binding so source and runtime identity cannot drift. data ExternalReadNode = ExternalReadNode-  { erName :: !Name,-    erVersion :: !Int,-    erQueryModel :: !Name,-    erResultSchema :: !Text,-    erResultType :: !Text,-    erCompatibleRevisions :: ![Name],-    erSurfaceGeneration :: !Int,-    erLoc :: !Loc+  { name :: !Name,+    version :: !Int,+    queryModel :: !Name,+    resultSchema :: !Text,+    resultType :: !Text,+    compatibleRevisions :: ![Name],+    surfaceGeneration :: !Int,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1348,7 +1352,7 @@ -- so source-level duplicate detection keys by contract and version together. externalReadNodeIdentity :: ExternalReadNode -> Name externalReadNodeIdentity externalRead =-  erName externalRead <> "_v" <> T.pack (show (erVersion externalRead))+  (.name) externalRead <> "_v" <> T.pack (show ((.version) externalRead))  -- | A replay source selected by a projection owner. data CatalogSource@@ -1375,17 +1379,17 @@  -- | One ordered live/replay handler declaration in the service catalog. data ProjectionOwnerNode = ProjectionOwnerNode-  { poName :: !Name,-    poSources :: ![CatalogSource],-    poDelivery :: !ProjectionDelivery,-    poGroup :: !Name,-    poTargets :: ![Name],-    poOrder :: !Int,-    poSubscription :: !(Maybe Text),-    poDedup :: !(Maybe Text),-    poCheckpointOnMissing :: ![CheckpointOnMissingNode],-    poReplay :: !ProjectionReplayPolicy,-    poLoc :: !Loc+  { name :: !Name,+    sources :: ![CatalogSource],+    delivery :: !ProjectionDelivery,+    group :: !Name,+    targets :: ![Name],+    order :: !Int,+    subscription :: !(Maybe Text),+    dedup :: !(Maybe Text),+    checkpointOnMissing :: ![CheckpointOnMissingNode],+    replay :: !ProjectionReplayPolicy,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1411,22 +1415,22 @@ -- | A durable @workflow@ node. data WorkflowNode = WorkflowNode   { -- | block identifier (e.g. @HospitalTransferReservation@)-    wfId :: !Name,+    id :: !Name,     -- | the stable @name "…"@ (journal stream + every deterministic id)-    wfStable :: !Text,-    wfInput :: !Name,-    wfInputFields :: ![Field],-    wfOutput :: !Name,+    stable :: !Text,+    input :: !Name,+    inputFields :: ![Field],+    output :: !Name,     -- | @id from input.<field>@; 'Nothing' for @id from input@-    wfIdField :: !(Maybe Name),-    wfIdVia :: !Name,-    wfBody :: ![WfBodyItem],-    wfLoc :: !Loc+    idField :: !(Maybe Name),+    idVia :: !Name,+    body :: ![WfBodyItem],+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  workflowNodeLoc :: WorkflowNode -> Loc-workflowNodeLoc WorkflowNode {wfLoc = loc} = loc+workflowNodeLoc WorkflowNode {loc = loc} = loc  -- | The four operation shapes. data OperationShape@@ -1441,9 +1445,9 @@   deriving stock (Eq, Show, Generic)  data OperationNode = OperationNode-  { opName :: !Name,-    opShape :: !OperationShape,-    opLoc :: !Loc+  { name :: !Name,+    shape :: !OperationShape,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -1489,14 +1493,14 @@ -- and the list of nodes. 'specModuleRoot' and 'specLayout' are 'Nothing' when the -- spec omits the clauses, reproducing the historical default. data Spec = Spec-  { specContext :: !Name,-    specModuleRoot :: !(Maybe Text),-    specLayout :: !(Maybe Placement),-    specIds :: ![IdDecl],-    specEnums :: ![EnumDecl],-    specRules :: ![RuleDecl],-    specNominalScalars :: ![NominalScalarDecl],-    specMapped :: ![MappedDecl],-    specNodes :: ![Node]+  { context :: !Name,+    moduleRoot :: !(Maybe Text),+    layout :: !(Maybe Placement),+    ids :: ![IdDecl],+    enums :: ![EnumDecl],+    rules :: ![RuleDecl],+    nominalScalars :: ![NominalScalarDecl],+    mapped :: ![MappedDecl],+    nodes :: ![Node]   }   deriving stock (Eq, Show, Generic)

src/Keiro/Dsl/Harness.hs view

@@ -89,10 +89,10 @@ harnessForCheckedWithGoldens :: [GoldenPayload] -> Context -> CheckedService -> Aggregate -> [ScaffoldModule] harnessForCheckedWithGoldens goldens ctx service agg =   [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" (aGenPrefix a) <> "/Harness.hs"),-        moduleText = emitHarness relevantGoldens a,+      { path = T.unpack (T.replace "." "/" ((.genPrefix) a) <> "/Harness.hs"),+        text = emitHarness relevantGoldens a,         kind = Generated,-        origin = "aggregate " <> aggName agg <> locSuffix (aggLoc agg)+        origin = "aggregate " <> (.name) agg <> locSuffix ((.loc) agg)       }   ]   where@@ -101,8 +101,8 @@     relevantGoldens =       [ golden       | golden <- goldens,-        goldenContext golden == specContext spec,-        goldenAggregate golden == aggName agg+        (.context) golden == (.context) spec,+        (.aggregate) golden == (.name) agg       ]  -- | Emit a self-contained, firewall-clean facts harness for a process manager,@@ -116,14 +116,14 @@ harnessProcess :: Context -> ProcessNode -> [ScaffoldModule] harnessProcess ctx p =   [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/ProcessHarness.hs"),-        moduleText = emitProcessHarness genPrefix p,+      { path = T.unpack (T.replace "." "/" genPrefix <> "/ProcessHarness.hs"),+        text = emitProcessHarness genPrefix p,         kind = Generated,-        origin = "process " <> procId p <> locSuffix (procLoc p)+        origin = "process " <> (.id) p <> locSuffix ((.loc) p)       }   ]   where-    genPrefix = genPrefixFor ctx (procId p)+    genPrefix = genPrefixFor ctx ((.id) p)  -- | Emit runtime-free facts for a router's identity, resolution, dispatch, -- and worker-policy decisions. A hand-written conformance driver owns the@@ -131,30 +131,30 @@ harnessRouter :: Context -> RouterNode -> [ScaffoldModule] harnessRouter ctx router =   [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/RouterHarness.hs"),-        moduleText = emitRouterHarness genPrefix router,+      { path = T.unpack (T.replace "." "/" genPrefix <> "/RouterHarness.hs"),+        text = emitRouterHarness genPrefix router,         kind = Generated,-        origin = "router " <> rtId router <> locSuffix (rtLoc router)+        origin = "router " <> (.id) router <> locSuffix ((.loc) router)       }   ]   where-    genPrefix = genPrefixFor ctx (rtId router)+    genPrefix = genPrefixFor ctx ((.id) router)  -- | Add checked declarative-selection evidence without changing any legacy -- custom-router harness bytes. harnessRouterForService :: Context -> CheckedService -> RouterNode -> [ScaffoldModule]-harnessRouterForService ctx service router = case rvSource (rtResolve router) of+harnessRouterForService ctx service router = case (.source) ((.resolve) router) of   ResolveDeclarative {} ->     [ ScaffoldModule-        { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/RouterHarness.hs"),-          moduleText = emitRouterHarnessWithFacts genPrefix (routerHarnessFactValuesForService service router),+        { path = T.unpack (T.replace "." "/" genPrefix <> "/RouterHarness.hs"),+          text = emitRouterHarnessWithFacts genPrefix (routerHarnessFactValuesForService service router),           kind = Generated,-          origin = "router " <> rtId router <> locSuffix (rtLoc router)+          origin = "router " <> (.id) router <> locSuffix ((.loc) router)         }     ]   _ -> harnessRouter ctx router   where-    genPrefix = genPrefixFor ctx (rtId router)+    genPrefix = genPrefixFor ctx ((.id) router)  emitRouterHarness :: Text -> RouterNode -> Text emitRouterHarness genPrefix router = emitRouterHarnessWithFacts genPrefix (routerHarnessFactValues router)@@ -172,39 +172,39 @@  routerHarnessFactValues :: RouterNode -> [(Text, Text)] routerHarnessFactValues router =-  [ ("routerName", rtName router),-    ("keyField", corrField (rtKey router)),+  [ ("routerName", (.name) router),+    ("keyField", (.field) ((.key) router)),     ("resolveSource", resolveSource),-    ("resolveRow", T.intercalate "," (rvRow (rtResolve router))),-    ("dispatchCommand", rdCommand dispatch),+    ("resolveRow", T.intercalate "," ((.row) ((.resolve) router))),+    ("dispatchCommand", (.command) dispatch),     ("dispatchIdInputs", "(name, key, sourceEventId, targetStreamName, occurrence)"),-    ("onDuplicate", showDisp (onDuplicate disposition)),-    ("onFailed", showDisp (onFailed disposition)),-    ("rejectedPolicy", showPolicy (rtRejected router)),-    ("poisonPolicy", showPolicy (rtPoison router))+    ("onDuplicate", showDisp ((.onDuplicate) disposition)),+    ("onFailed", showDisp ((.onFailed) disposition)),+    ("rejectedPolicy", showPolicy ((.rejected) router)),+    ("poisonPolicy", showPolicy ((.poison) router))   ]   where-    dispatch = rtDispatch router-    disposition = rdDisposition dispatch-    resolveSource = case rvSource (rtResolve router) of+    dispatch = (.dispatch) router+    disposition = (.disposition) dispatch+    resolveSource = case (.source) ((.resolve) router) of       ResolveReadModel name -> "read-model " <> name       ResolveHole -> "hole"-      ResolveDeclarative selection -> "declarative " <> rsIdentity selection+      ResolveDeclarative selection -> "declarative " <> (.identity) selection  routerHarnessFactValuesForService :: CheckedService -> RouterNode -> [(Text, Text)]-routerHarnessFactValuesForService service router = case rvSource (rtResolve router) of+routerHarnessFactValuesForService service router = case (.source) ((.resolve) router) of   ResolveDeclarative {} ->     routerHarnessFactValues router       <> [ ("resolverOwnership", "generated-declarative"),-           ("queryIdentity", checkedQueryName (checkedQuery selection)),-           ("selectionIdentity", checkedIdentity selection),-           ("selectionVersion", T.pack (show (checkedVersion selection))),-           ("selectionFingerprint", checkedFingerprint selection),-           ("maxRecipients", T.pack (show (checkedLimit selection))),+           ("queryIdentity", (.name) ((.query) selection)),+           ("selectionIdentity", (.identity) selection),+           ("selectionVersion", T.pack (show ((.version) selection))),+           ("selectionFingerprint", (.fingerprint) selection),+           ("maxRecipients", T.pack (show ((.limit) selection))),            ("selectionOrder", "target-stream"),            ("selectionDedupe", "target-stream"),-           ("emptyPolicy", checkedEmptyPolicyText (checkedEmptyPolicy selection)),-           ("failurePolicy", checkedFailurePolicyText (checkedFailurePolicy selection)),+           ("emptyPolicy", checkedEmptyPolicyText ((.emptyPolicy) selection)),+           ("failurePolicy", checkedFailurePolicyText ((.failurePolicy) selection)),            ("redeliveryPolicy", "stable-union"),            ("partialPolicy", "retain-successes")          ]@@ -234,14 +234,14 @@ harnessReadModelForService :: Context -> CheckedService -> ReadModelNode -> [ScaffoldModule] harnessReadModelForService ctx service readModel =   [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/ReadModelHarness.hs"),-        moduleText = emitReadModelHarness genPrefix ctx (checkedSpec service) (checkedProjectionSupplies service) readModel,+      { path = T.unpack (T.replace "." "/" genPrefix <> "/ReadModelHarness.hs"),+        text = emitReadModelHarness genPrefix ctx (checkedSpec service) (checkedProjectionSupplies service) readModel,         kind = Generated,-        origin = "readmodel " <> rmName readModel <> locSuffix (rmLoc readModel)+        origin = "readmodel " <> (.name) readModel <> locSuffix ((.loc) readModel)       }   ]   where-    genPrefix = genPrefixFor ctx (pascal (rmName readModel))+    genPrefix = genPrefixFor ctx (pascal ((.name) readModel))  emitReadModelHarness :: Text -> Context -> Spec -> ProjectionSupplyAnalysis -> ReadModelNode -> Text emitReadModelHarness genPrefix ctx spec supplyAnalysis readModel =@@ -280,13 +280,13 @@            "  pure (null failures)"          ]   where-    stem = lowerFirst (pascal (rmName readModel))+    stem = lowerFirst (pascal ((.name) readModel))     readModelName = stem <> "ReadModel"     asyncProjectionName = stem <> "AsyncProjection"     readModelImports = readModelName : [asyncProjectionName | emitsLegacyAsync]     moduleExports = ["readModelFacts", "readModelFactResults", "runReadModelFacts"] <> ["catalogFactsAgainst" | catalogManaged]-    expectedRegistry = registryNameFor (contextName ctx) readModel-    ownerDerived = rmSupply readModel == OwnerDerivedSupply+    expectedRegistry = registryNameFor ((.name) ctx) readModel+    ownerDerived = (.supply) readModel == OwnerDerivedSupply     expectedSubscription = case legacyReadModelSubscription readModel of       Just name -> name       Nothing -> expectedRegistry <> "-sub"@@ -296,7 +296,7 @@     asyncFactRow = case legacyReadModelFeed readModel of       Just RmSubscription -> "  , (\"asyncProjectionName\", " <> tshow expectedAsync <> ", T.unpack " <> asyncProjectionName <> ".name)"       _ -> "  , (\"asyncProjectionName\", \"none\", \"none\") -- Definitionally inert: inline feeds have no AsyncProjection value."-    catalogManaged = rmGroup readModel /= Nothing+    catalogManaged = (.group) readModel /= Nothing     emitsLegacyAsync = not ownerDerived && not catalogManaged && legacyReadModelFeed readModel == Just RmSubscription     runtimeImports       | ownerDerived = "ReadModel (..), readModelCursorAuthority, readModelDefaultFreshness"@@ -304,12 +304,12 @@     baseFactRows       | ownerDerived =           [ "  [ (\"registryName\", " <> tshow expectedRegistry <> ", T.unpack " <> readModelName <> ".name)",-            "  , (\"shapeHash\", " <> tshow (rmShape readModel) <> ", T.unpack " <> readModelName <> ".shapeHash)"+            "  , (\"shapeHash\", " <> tshow ((.shape) readModel) <> ", T.unpack " <> readModelName <> ".shapeHash)"           ]       | otherwise =           [ "  [ (\"registryName\", " <> tshow expectedRegistry <> ", T.unpack " <> readModelName <> ".name)",             "  , (\"subscriptionName\", " <> tshow expectedSubscription <> ", T.unpack " <> readModelName <> ".subscriptionName)",-            "  , (\"shapeHash\", " <> tshow (rmShape readModel) <> ", T.unpack " <> readModelName <> ".shapeHash)"+            "  , (\"shapeHash\", " <> tshow ((.shape) readModel) <> ", T.unpack " <> readModelName <> ".shapeHash)"           ]     policyFactRows       | ownerDerived =@@ -337,48 +337,48 @@       | otherwise = []     supply =       find-        ((== rmName readModel) . supplyQueryModel)-        (resolvedProjectionSupplies supplyAnalysis)+        ((== (.name) readModel) . (.queryModel))+        ((.resolvedProjectionSupplies) supplyAnalysis)     resolvedOwner = do       resolved <- supply       find-        ((== supplyProjectionOwner resolved) . poName)-        [owner | NProjectionOwner owner <- specNodes spec]+        ((== (.projectionOwner) resolved) . (.name))+        [owner | NProjectionOwner owner <- (.nodes) spec]     expectedCursor = case resolvedOwner of       Just owner-        | poDelivery owner == DeliverySubscription,-          Just subscription <- poSubscription owner ->+        | (.delivery) owner == DeliverySubscription,+          Just subscription <- (.subscription) owner ->             "DurableQueryCursor " <> T.pack (show subscription)       _ -> "NoQueryCursor"-    expectedFreshness = case rmFreshness readModel of+    expectedFreshness = case (.freshness) readModel of       FreshnessImmediate -> "Immediate"       FreshnessWaitForHead RmEntireLog -> "WaitForHead EntireVisibleLog"       FreshnessWaitForHead (RmCategory categoryName) -> "WaitForHead (CategoryVisibleHead " <> T.pack (show categoryName) <> ")"     feedingOwners =       sortOn-        poOrder+        (.order)         [ owner         | Just resolved <- [supply],-          NProjectionOwner owner <- specNodes spec,-          poName owner == supplyProjectionOwner resolved,-          poDelivery owner == DeliverySubscription+          NProjectionOwner owner <- (.nodes) spec,+          (.name) owner == (.projectionOwner) resolved,+          (.delivery) owner == DeliverySubscription         ]     expectedCatalogRegistration =       T.intercalate         "|"         [ expectedRegistry,-          T.pack (show (rmVersion readModel)),-          rmShape readModel,-          fromMaybe "" (rmGroup readModel)+          T.pack (show ((.version) readModel)),+          (.shape) readModel,+          fromMaybe "" ((.group) readModel)         ]     expectedCatalogSupply = case supply of       Nothing -> "missing"       Just resolved ->         T.intercalate           "|"-          [ supplyProjectionOwner resolved,-            supplyRebuildGroup resolved,-            T.intercalate "," (NE.toList (supplyObservedTargets resolved))+          [ (.projectionOwner) resolved,+            (.rebuildGroup) resolved,+            T.intercalate "," (NE.toList ((.observedTargets) resolved))           ]     catalogHelpers       | not catalogManaged = []@@ -421,31 +421,31 @@       [ "  [ (\"catalogRegistration\", "           <> tshow expectedCatalogRegistration           <> ", renderRegistration [entry | entry <- registrations, Catalog.queryModelIdText entry.queryModelId == "-          <> tshow (rmName readModel)+          <> tshow ((.name) readModel)           <> "])",         "  , (\"querySupply\", "           <> tshow expectedCatalogSupply           <> ", renderSupply [entry | entry <- supplies, Catalog.queryModelIdText entry.resolvedQueryModelId == "-          <> tshow (rmName readModel)+          <> tshow ((.name) readModel)           <> "])",         "  , (\"projectionDelivery\", "           <> tshow expectedDelivery           <> ", renderDelivery [entry | entry <- supplies, Catalog.queryModelIdText entry.resolvedQueryModelId == "-          <> tshow (rmName readModel)+          <> tshow ((.name) readModel)           <> "])"       ]         <> [ "  , (\"asyncRegistration:"-               <> poName owner+               <> (.name) owner                <> "\", "-               <> tshow (T.intercalate "|" [fromMaybe "" (poSubscription owner), fromMaybe "" (poDedup owner)])+               <> tshow (T.intercalate "|" [fromMaybe "" ((.subscription) owner), fromMaybe "" ((.dedup) owner)])                <> ", renderAsync [entry | entry <- asyncRegistrations, Catalog.projectionIdText entry.projectionId == "-               <> tshow (poName owner)+               <> tshow ((.name) owner)                <> "])"            | owner <- feedingOwners            ]         <> ["  ]"]     expectedDelivery = case resolvedOwner of-      Just owner -> case poDelivery owner of+      Just owner -> case (.delivery) owner of         DeliveryInline -> "inline"         DeliverySubscription -> "subscription"       Nothing -> "missing"@@ -476,25 +476,25 @@  processHarnessFactValues :: ProcessNode -> [(Text, Text)] processHarnessFactValues p =-  [ ("fireAtField", faField (tmFireAt timer)),-    ("timerIdPrefix", idePrefix (tmId timer)),-    ("firedEventIdPrefix", idePrefix (fireFiredEventId timer')),+  [ ("fireAtField", (.field) ((.fireAt) timer)),+    ("timerIdPrefix", (.prefix) ((.id) timer)),+    ("firedEventIdPrefix", (.prefix) ((.firedEventId) timer')),     ("dispatchIdUserField", "none"),-    ("onReject", showFireOutcome (onReject fd)),-    ("onAmbiguous", showFireOutcome (onAmbiguous fd)),-    ("onFailed", showDisp (onFailed (firstDispDisposition p))),-    ("rejectedPolicy", showPolicy (procRejected p)),-    ("poisonPolicy", showPolicy (procPoison p)),-    ("maxAttempts", tInt (tmMaxAttempts timer))+    ("onReject", showFireOutcome ((.onReject) fd)),+    ("onAmbiguous", showFireOutcome ((.onAmbiguous) fd)),+    ("onFailed", showDisp ((.onFailed) (firstDispDisposition p))),+    ("rejectedPolicy", showPolicy ((.rejected) p)),+    ("poisonPolicy", showPolicy ((.poison) p)),+    ("maxAttempts", tInt ((.maxAttempts) timer))   ]   where-    timer = procTimer p-    timer' = tmFire timer-    fd = fireDisposition timer'+    timer = (.timer) p+    timer' = (.fire) timer+    fd = (.disposition) timer'  firstDispDisposition :: ProcessNode -> DispatchDisposition-firstDispDisposition p = case hDispatch (procHandle p) of-  (d : _) -> dispDisposition d+firstDispDisposition p = case (.dispatch) ((.handle) p) of+  (d : _) -> (.disposition) d   [] -> DispatchDisposition DAckOk DAckOk DRetry  showFireOutcome :: FireOutcome -> Text@@ -523,20 +523,20 @@ harnessWorkflow :: Context -> WorkflowNode -> [ScaffoldModule] harnessWorkflow ctx w =   [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/WorkflowFacts.hs"),-        moduleText = emitWorkflowFacts genPrefix w,+      { path = T.unpack (T.replace "." "/" genPrefix <> "/WorkflowFacts.hs"),+        text = emitWorkflowFacts genPrefix w,         kind = Generated,-        origin = "workflow " <> wfId w <> locSuffix (workflowNodeLoc w)+        origin = "workflow " <> (.id) w <> locSuffix (workflowNodeLoc w)       },     ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/WorkflowRuntime.hs"),-        moduleText = emitWorkflowRuntime genPrefix w,+      { path = T.unpack (T.replace "." "/" genPrefix <> "/WorkflowRuntime.hs"),+        text = emitWorkflowRuntime genPrefix w,         kind = Generated,-        origin = "workflow " <> wfId w <> locSuffix (workflowNodeLoc w)+        origin = "workflow " <> (.id) w <> locSuffix (workflowNodeLoc w)       }   ]   where-    genPrefix = genPrefixFor ctx (wfId w)+    genPrefix = genPrefixFor ctx ((.id) w)  locSuffix :: Loc -> Text locSuffix loc = case unLoc loc of@@ -565,23 +565,23 @@       "workflowFacts :: WorkflowFacts",       "workflowFacts =",       "  WorkflowFacts",-      "    { workflowFactName = " <> hs (wfStable w),-      "    , workflowFactIdVia = " <> hs (wfIdVia w),-      "    , workflowFactIdField = " <> hs (maybe "input" id (wfIdField w)),-      "    , workflowFactBody = " <> stringList (map bodyTag (wfBody w)),-      "    , workflowFactAwaitLabels = " <> stringList (workflowAwaitLabels (wfBody w)),-      "    , workflowFactPatchIds = " <> stringList (workflowPatchIds (wfBody w)),+      "    { workflowFactName = " <> hs ((.stable) w),+      "    , workflowFactIdVia = " <> hs ((.idVia) w),+      "    , workflowFactIdField = " <> hs (maybe "input" id ((.idField) w)),+      "    , workflowFactBody = " <> stringList (map bodyTag ((.body) w)),+      "    , workflowFactAwaitLabels = " <> stringList (workflowAwaitLabels ((.body) w)),+      "    , workflowFactPatchIds = " <> stringList (workflowPatchIds ((.body) w)),       "    }",       "",       "-- | Base-library projection used by the service-level conformance facade.",       "workflowFactValues :: [(String, String)]",       "workflowFactValues =",-      "  [ (\"name\", workflowFactName workflowFacts)",-      "  , (\"idVia\", workflowFactIdVia workflowFacts)",-      "  , (\"idField\", workflowFactIdField workflowFacts)",-      "  , (\"body\", show (workflowFactBody workflowFacts))",-      "  , (\"awaits\", show (workflowFactAwaitLabels workflowFacts))",-      "  , (\"patches\", show (workflowFactPatchIds workflowFacts))",+      "  [ (\"name\", workflowFacts.workflowFactName)",+      "  , (\"idVia\", workflowFacts.workflowFactIdVia)",+      "  , (\"idField\", workflowFacts.workflowFactIdField)",+      "  , (\"body\", show workflowFacts.workflowFactBody)",+      "  , (\"awaits\", show workflowFacts.workflowFactAwaitLabels)",+      "  , (\"patches\", show workflowFacts.workflowFactPatchIds)",       "  ]"     ]   where@@ -596,12 +596,12 @@  workflowHarnessFactValues :: WorkflowNode -> [(Text, Text)] workflowHarnessFactValues workflow =-  [ ("name", wfStable workflow),-    ("idVia", wfIdVia workflow),-    ("idField", maybe "input" id (wfIdField workflow)),-    ("body", T.pack (show (map (T.unpack . bodyTag) (wfBody workflow)))),-    ("awaits", T.pack (show (map T.unpack (workflowAwaitLabels (wfBody workflow))))),-    ("patches", T.pack (show (map T.unpack (workflowPatchIds (wfBody workflow)))))+  [ ("name", (.stable) workflow),+    ("idVia", (.idVia) workflow),+    ("idField", maybe "input" id ((.idField) workflow)),+    ("body", T.pack (show (map (T.unpack . bodyTag) ((.body) workflow)))),+    ("awaits", T.pack (show (map T.unpack (workflowAwaitLabels ((.body) workflow))))),+    ("patches", T.pack (show (map T.unpack (workflowPatchIds ((.body) workflow)))))   ]   where     bodyTag (WfStep label _ _) = "step:" <> label@@ -648,7 +648,7 @@            "import Kiroku.Store.Effect (Store)",            "",            "workflowName :: WorkflowName",-           "workflowName = WorkflowName " <> tshow (wfStable w),+           "workflowName = WorkflowName " <> tshow ((.stable) w),            "",            "-- | A declared await label. The constructor stays private so consumers",            "-- can allocate only labels that exist in the source workflow.",@@ -663,10 +663,10 @@          ]       ++ concatMap emitBinding awaitBindings       ++ [ "awaitLabels :: [Text]",-           "awaitLabels = [" <> T.intercalate ", " (map tshow (workflowAwaitLabels (wfBody w))) <> "]",+           "awaitLabels = [" <> T.intercalate ", " (map tshow (workflowAwaitLabels ((.body) w))) <> "]",            "",            "declaredPatches :: Set PatchId",-           "declaredPatches = Set.fromList [" <> T.intercalate ", " ["PatchId " <> tshow patchId | patchId <- workflowPatchIds (wfBody w)] <> "]",+           "declaredPatches = Set.fromList [" <> T.intercalate ", " ["PatchId " <> tshow patchId | patchId <- workflowPatchIds ((.body) w)] <> "]",            "",            "-- The journal keys the runtime records patch decisions under.",            "declaredPatchStepNames :: [Text]",@@ -679,7 +679,7 @@   where     awaitBindings =       [ (workflowAwaitBindingName w label loc, label)-      | (label, loc) <- workflowAwaits (wfBody w)+      | (label, loc) <- workflowAwaits ((.body) w)       ]     emitBinding (bindingName, label) =       [ bindingName <> " :: AwaitBinding",@@ -695,10 +695,10 @@   where     site =       HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedValueSite,-          HaskellName.siteLogicalName = label,-          HaskellName.siteOwner = "workflow:" <> wfId workflow <> ":await:" <> label,-          HaskellName.siteLine = unLoc loc+        { HaskellName.kind = HaskellName.GeneratedValueSite,+          HaskellName.logicalName = label,+          HaskellName.owner = "workflow:" <> (.id) workflow <> ":await:" <> label,+          HaskellName.line = unLoc loc         }  workflowAwaits :: [WfBodyItem] -> [(Name, Loc)]@@ -724,9 +724,9 @@ emitHarness :: [GoldenPayload] -> Agg -> Text emitHarness goldens a =   nl $-    renderGeneratedLanguagePragmas [ExtOverloadedLabels | not (null replayTransitions) && not (null (aRegs a))]+    renderGeneratedLanguagePragmas [ExtOverloadedLabels | not (null replayTransitions) && not (null ((.regs) a))]       ++ [ generatedBanner,-           "module " <> aGenPrefix a <> ".Harness (harnessAssertions) where",+           "module " <> (.genPrefix) a <> ".Harness (harnessAssertions) where",            ""          ]       ++ harnessImports@@ -739,17 +739,17 @@            "  [ (\"validateTransducer is empty\", null (validateTransducer defaultValidationOptions " <> lowerFirst nm <> "Transducer))"          ]       ++ clockFreeRows-      ++ [ "  , (\"golden round-trip: " <> rcName e <> "\", roundTrips sampleEvent" <> rcName e <> ")"-         | e <- aEvents a+      ++ [ "  , (\"golden round-trip: " <> (.name) e <> "\", roundTrips sampleEvent" <> (.name) e <> ")"+         | e <- (.events) a          ]-      ++ [ "  , (\"accepts " <> tCommand t <> " from " <> initialVertex a <> "\", accept" <> tCommand t <> ")"-         | t <- map layoutTransition (initialLiveTransitionEntries a)+      ++ [ "  , (\"accepts " <> (.command) t <> " from " <> initialVertex a <> "\", accept" <> (.command) t <> ")"+         | t <- map (.transition) (initialLiveTransitionEntries a)          ]       ++ [ "  ]"          ]       ++ ["  ++ mappedConformanceAssertions" | hasMappedHarness a]       ++ ["  ++ nominalConformanceAssertions" | hasNominalHarness a]-      ++ [ "  ++ forwardReplay" <> tCommand t+      ++ [ "  ++ forwardReplay" <> (.command) t          | t <- replayTransitions          ]       ++ ( if null upcastEvents@@ -764,34 +764,34 @@            "roundTrips e = parse" <> nm <> "Event (eventType " <> lowerFirst nm <> "Codec e) (encode" <> nm <> "Event e) == Right e"          ]       ++ harnessSampleDeclarations a-      ++ concatMap (sampleEventDecl a) (aEvents a)-      ++ concatMap (acceptDecl a . layoutTransition) (initialLiveTransitionEntries a)+      ++ concatMap (sampleEventDecl a) ((.events) a)+      ++ concatMap (acceptDecl a . (.transition)) (initialLiveTransitionEntries a)       ++ concatMap (forwardReplayDecl a) replayTransitions       ++ concatMap (upcastDecl goldens a) upcastEvents       ++ mappedHarnessDeclarations a       ++ nominalHarnessDeclarations a   where-    nm = aName a+    nm = (.name) a     clockFreeRows =       if specIsClockFree a         then ["  -- clock-free: spec samples no wall clock (verified at scaffold time)"]         else ["  , (\"clock-free: spec samples no wall clock\", False)"]-    upcastEvents = [e | e <- aEvents a, rcUpcastFrom e /= Nothing]+    upcastEvents = [e | e <- (.events) a, (.upcastFrom) e /= Nothing]     replayTransitions =       [ t       | entry <- initialLiveTransitionEntries a,-        let t = layoutTransition entry,-        not (null (tEmits t))+        let t = (.transition) entry,+        not (null ((.emits) t))       ]     coreImports =       ["applyEventsEither" | not (null replayTransitions)]         ++ ["defaultValidationOptions", "step", "validateTransducer"]         ++ ["fieldWitnessAgrees" | not (null (nominalScalarHarnessTypes a)) || not (null (enforcedConsumerNominalIdHarnessTypes a))]-        ++ ["(!)" | not (null replayTransitions) && not (null (aRegs a))]+        ++ ["(!)" | not (null replayTransitions) && not (null ((.regs) a))]     upcastAssertions =-      [ "(" <> tshow (upcastLabel e m) <> ", upcasts" <> rcName e <> ")"+      [ "(" <> tshow (upcastLabel e m) <> ", upcasts" <> (.name) e <> ")"       | e <- upcastEvents,-        Just m <- [rcUpcastFrom e]+        Just m <- [(.upcastFrom) e]       ]     codecValueImport = ", " <> lowerFirst nm <> "Codec"     codecDecodeRawImport =@@ -807,13 +807,13 @@         else []     harnessImports =       unique $-        [ "import " <> aGenPrefix a <> ".Domain",-          "import " <> aGenPrefix a <> ".Codec (encode" <> nm <> "Event, parse" <> nm <> "Event" <> codecValueImport <> mappedCodecHarnessExports a <> ")",+        [ "import " <> (.genPrefix) a <> ".Domain",+          "import " <> (.genPrefix) a <> ".Codec (encode" <> nm <> "Event, parse" <> nm <> "Event" <> codecValueImport <> mappedCodecHarnessExports a <> ")",           transducerImport a,           "import Keiki.Core (" <> T.intercalate ", " coreImports <> ")",           codecDecodeRawImport         ]-          ++ generatedNominalTypeImportsForService (aggregateCheckedService a) (aContext a) (generatedNominalHarnessTypes a)+          ++ generatedNominalTypeImportsForService (aggregateCheckedService a) ((.context) a) (generatedNominalHarnessTypes a)           ++ mappedHarnessImports a           ++ nominalHarnessImports a           ++ aggregateHarnessImports a@@ -822,52 +822,52 @@      upcastLabel event source =       case goldenFor goldens event of-        Just _ -> "golden " <> rcName event <> ".v" <> tInt source <> " decodes"+        Just _ -> "golden " <> (.name) event <> ".v" <> tInt source <> " decodes"         Nothing ->           "upcast "-            <> rcName event+            <> (.name) event             <> " chain wired (current-shape stand-in; add a golden payload)"  transducerImport :: Agg -> Text transducerImport aggregate   | usesGeneratedTransducer aggregate =       "import "-        <> aGenPrefix aggregate+        <> (.genPrefix) aggregate         <> ".Transducer ("-        <> lowerFirst (aName aggregate)+        <> lowerFirst ((.name) aggregate)         <> "Transducer)"   | otherwise =       "import "-        <> aHolePrefix aggregate+        <> (.holePrefix) aggregate         <> ".Holes ("-        <> lowerFirst (aName aggregate)+        <> lowerFirst ((.name) aggregate)         <> "Transducer)"  usesGeneratedTransducer :: Agg -> Bool-usesGeneratedTransducer = any ((/= LegacyHoleImplementation) . tImplementation) . aTransitions+usesGeneratedTransducer = any ((/= LegacyHoleImplementation) . (.implementation)) . (.transitions)  -- | Decode a genuine embedded old payload when available. Without a golden, -- retain the weaker current-shape wiring assertion and label it honestly. upcastDecl :: [GoldenPayload] -> Agg -> ResolvedCtor -> [Text]-upcastDecl goldens a e = case rcUpcastFrom e of+upcastDecl goldens a e = case (.upcastFrom) e of   Nothing -> []   Just m -> case goldenFor goldens e of     Just golden ->       [ "",-        "upcasts" <> rcName e <> " :: Bool",-        "upcasts" <> rcName e <> " =",-        "  case eitherDecodeStrict (encodeUtf8 " <> tshow (goldenJson golden) <> ") of",+        "upcasts" <> (.name) e <> " :: Bool",+        "upcasts" <> (.name) e <> " =",+        "  case eitherDecodeStrict (encodeUtf8 " <> tshow ((.json) golden) <> ") of",         "    Left _ -> False",         "    Right payload ->",         "      either (const False) (const True)",-        "        (decodeRaw " <> lowerFirst (aName a) <> "Codec (EventType " <> tshow (rcName e) <> ") " <> tInt m <> " payload)"+        "        (decodeRaw " <> lowerFirst ((.name) a) <> "Codec (EventType " <> tshow ((.name) e) <> ") " <> tInt m <> " payload)"       ]     Nothing ->       [ "",-        "upcasts" <> rcName e <> " :: Bool",-        "upcasts" <> rcName e <> " =",+        "upcasts" <> (.name) e <> " :: Bool",+        "upcasts" <> (.name) e <> " =",         "  either (const False) (const True)",-        "    (decodeRaw " <> lowerFirst (aName a) <> "Codec (EventType " <> tshow (rcName e) <> ") " <> tInt m <> " (encode" <> aName a <> "Event sampleEvent" <> rcName e <> "))"+        "    (decodeRaw " <> lowerFirst ((.name) a) <> "Codec (EventType " <> tshow ((.name) e) <> ") " <> tInt m <> " (encode" <> (.name) a <> "Event sampleEvent" <> (.name) e <> "))"       ]  hasGolden :: [GoldenPayload] -> ResolvedCtor -> Bool@@ -877,9 +877,9 @@  goldenFor :: [GoldenPayload] -> ResolvedCtor -> Maybe GoldenPayload goldenFor goldens event = do-  source <- rcUpcastFrom event+  source <- (.upcastFrom) event   find-    (\golden -> goldenEvent golden == rcName event && goldenVersion golden == source)+    (\golden -> (.event) golden == (.name) event && (.version) golden == source)     goldens  tInt :: Int -> Text@@ -893,11 +893,11 @@ nl = T.intercalate "\n"  specIsClockFree :: Agg -> Bool-specIsClockFree a = not (any transitionSamplesClock (aTransitions a))+specIsClockFree a = not (any transitionSamplesClock ((.transitions) a))   where     clockAtoms = ["now", "currentTime", "wallClock", "today", "utcNow"]     transitionSamplesClock t =-      let exprs = maybe [] pure (tGuard t) ++ map snd (tWrites t)+      let exprs = maybe [] pure ((.guard) t) ++ map snd ((.writes) t)        in any (\e -> any (`elem` clockAtoms) (exprNames e)) exprs  exprNames :: Expr -> [Text]@@ -914,11 +914,11 @@ exprNames (EAtom (ABool _)) = []  initialLiveTransitionEntries :: Agg -> [TransitionLayoutEntry]-initialLiveTransitionEntries a = case map stName (aStates a) of+initialLiveTransitionEntries a = case map (.name) ((.states) a) of   (s0 : _) ->     [ entry-    | entry <- transitionLayoutForSource s0 (transitionLayout (aTransitions a)),-      tMode (layoutTransition entry) == TmLive+    | entry <- transitionLayoutForSource s0 (transitionLayout ((.transitions) a)),+      (.mode) ((.transition) entry) == TmLive     ]   [] -> [] @@ -928,8 +928,8 @@ sampleEventDecl :: Agg -> ResolvedCtor -> [Text] sampleEventDecl a e =   [ "",-    "sampleEvent" <> rcName e <> " :: " <> aName a <> "Event",-    "sampleEvent" <> rcName e <> " = " <> ctorExpr a e+    "sampleEvent" <> (.name) e <> " :: " <> (.name) a <> "Event",+    "sampleEvent" <> (.name) e <> " = " <> ctorExpr a e   ]  harnessSampleDeclarations :: Agg -> [Text]@@ -939,13 +939,13 @@     generatedIds =       [ nominal       | nominal <- generatedNominalHarnessTypes aggregate,-        IdRepresentation prefix <- [resolvedNominalRepresentation nominal],-        idDomainContractFor (aLanguageContract aggregate) prefix /= Nothing+        IdRepresentation prefix <- [(.representation) nominal],+        idDomainContractFor ((.languageContract) aggregate) prefix /= Nothing       ]-    generatedIdDeclaration nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> case idDomainContractFor (aLanguageContract aggregate) prefix of+    generatedIdDeclaration nominal = case (.representation) nominal of+      IdRepresentation prefix -> case idDomainContractFor ((.languageContract) aggregate) prefix of         Just contract ->-          let typeName = resolvedNominalName nominal+          let typeName = (.name) nominal               constantName = generatedIdSampleName nominal            in [ "",                 constantName <> " :: " <> typeName,@@ -967,14 +967,14 @@ acceptDecl :: Agg -> Transition -> [Text] acceptDecl a t =   [ "",-    "accept" <> tCommand t <> " :: Bool",-    "accept" <> tCommand t <> " =",-    "  case step " <> lowerFirst (aName a) <> "Transducer (" <> initialVertex a <> ", initial" <> aName a <> "Regs) " <> cmdSample <> " of",-    "    Just (v, _, _) -> v == " <> vertexCtor a (tGoto t),+    "accept" <> (.command) t <> " :: Bool",+    "accept" <> (.command) t <> " =",+    "  case step " <> lowerFirst ((.name) a) <> "Transducer (" <> initialVertex a <> ", initial" <> (.name) a <> "Regs) " <> cmdSample <> " of",+    "    Just (v, _, _) -> v == " <> vertexCtor a ((.goto) t),     "    Nothing -> False"   ]   where-    cmdSample = case [c | c <- aCommands a, rcName c == tCommand t] of+    cmdSample = case [c | c <- (.commands) a, (.name) c == (.command) t] of       (c : _) -> "(" <> commandCtorExpr a t c <> ")"       [] -> "(error \"no command\")" @@ -996,32 +996,32 @@     "            Right (replayVertex, " <> replayRegsName <> ") ->",     "              [ (prefix <> \"final vertex\", replayVertex == forwardVertex)"   ]-    ++ [ "              , (prefix <> \"register " <> rrName reg <> "\", (replayRegs ! #" <> rrName reg <> ") == (forwardRegs ! #" <> rrName reg <> "))"-       | reg <- aRegs a+    ++ [ "              , (prefix <> \"register " <> (.name) reg <> "\", (replayRegs ! #" <> (.name) reg <> ") == (forwardRegs ! #" <> (.name) reg <> "))"+       | reg <- (.regs) a        ]     ++ [ "              ]",          "  where",-         "    prefix = \"forward/replay equality: " <> tCommand t <> " from " <> initial <> " -- \""+         "    prefix = \"forward/replay equality: " <> (.command) t <> " from " <> initial <> " -- \""        ]   where-    nm = aName a-    helperName = "forwardReplay" <> tCommand t+    nm = (.name) a+    helperName = "forwardReplay" <> (.command) t     transducer = lowerFirst nm <> "Transducer"     codec = lowerFirst nm <> "Codec"     initial = initialVertex a     initialRegs = "initial" <> nm <> "Regs"-    forwardRegsName = if null (aRegs a) then "_forwardRegs" else "forwardRegs"-    replayRegsName = if null (aRegs a) then "_replayRegs" else "replayRegs"-    cmdSample = case [c | c <- aCommands a, rcName c == tCommand t] of+    forwardRegsName = if null ((.regs) a) then "_forwardRegs" else "forwardRegs"+    replayRegsName = if null ((.regs) a) then "_replayRegs" else "replayRegs"+    cmdSample = case [c | c <- (.commands) a, (.name) c == (.command) t] of       (c : _) -> "(" <> commandCtorExpr a t c <> ")"       [] -> "(error \"no command\")"  -- | @(<Ctor> (<Ctor>Data v1 v2 …))@ with positional sample field values. ctorExpr :: Agg -> ResolvedCtor -> Text ctorExpr a rc =-  rcName rc <> " (" <> rcName rc <> "Data" <> args <> ")"+  (.name) rc <> " (" <> (.name) rc <> "Data" <> args <> ")"   where-    args = T.concat [" " <> sampleValue a (fieldDslName identity) ty | (identity, ty) <- rcFields rc]+    args = T.concat [" " <> sampleValue a ((.dslName) identity) ty | (identity, ty) <- (.fields) rc]  -- | A transition command sample prefers the initial value of a same-named, -- same-typed register only when the guard explicitly equates those two paths.@@ -1029,34 +1029,34 @@ -- not accidentally inherit a forbidden @Free@ register initial value. commandCtorExpr :: Agg -> Transition -> ResolvedCtor -> Text commandCtorExpr a transition rc =-  rcName rc <> " (" <> rcName rc <> "Data" <> args <> ")"+  (.name) rc <> " (" <> (.name) rc <> "Data" <> args <> ")"   where-    args = T.concat [" " <> commandSampleValue a transition (fieldDslName identity) ty | (identity, ty) <- rcFields rc]+    args = T.concat [" " <> commandSampleValue a transition ((.dslName) identity) ty | (identity, ty) <- (.fields) rc]  commandSampleValue :: Agg -> Transition -> Text -> ResolvedAggregateType -> Text-commandSampleValue aggregate transition fieldName fieldType = case fieldType of+commandSampleValue aggregate transition name valueType = case valueType of   AggregateNominal _-    | guardEquatesCommandAndRegister transition fieldName -> case find matchesRegister (aRegs aggregate) of+    | guardEquatesCommandAndRegister transition name -> case find matchesRegister ((.regs) aggregate) of         Just register -> regInitialValueForHarness aggregate register         Nothing -> fallback   _ -> fallback   where-    fallback = sampleValue aggregate fieldName fieldType-    matchesRegister register = rrName register == fieldName && rrType register == fieldType-    regInitialValueForHarness owner register = case rrInitial register of+    fallback = sampleValue aggregate name valueType+    matchesRegister register = (.name) register == name && (.valueType) register == valueType+    regInitialValueForHarness owner register = case (.initial) register of       InitialNominal _ value -> renderHarnessReference owner (harnessQualifiedValueReference value)       InitialMapped _ value -> renderHarnessReference owner (harnessQualifiedValueReference value)-      _ -> case rrType register of-        AggregateNominal nominal -> case resolvedNominalOwnership nominal of-          ConsumerNominal {} -> renderRegisterInitial (rrInitial register)+      _ -> case (.valueType) register of+        AggregateNominal nominal -> case (.ownership) nominal of+          ConsumerNominal {} -> renderRegisterInitial ((.initial) register)           GeneratedNominal ->             fromMaybe-              (renderRegisterInitial (rrInitial register))+              (renderRegisterInitial ((.initial) register))               (generatedIdSampleName nominal <$ generatedIdSampleHaskell owner nominal)-        _ -> renderRegisterInitial (rrInitial register)+        _ -> renderRegisterInitial ((.initial) register)  guardEquatesCommandAndRegister :: Transition -> Text -> Bool-guardEquatesCommandAndRegister transition fieldName = maybe False containsEquality (tGuard transition)+guardEquatesCommandAndRegister transition name = maybe False containsEquality ((.guard) transition)   where     containsEquality = \case       EOr left right -> containsEquality left || containsEquality right@@ -1064,46 +1064,46 @@       ECmp OpEq left right -> matchingPaths left right || matchingPaths right left       _ -> False     matchingPaths (EPath _ CommandRoot [commandField]) (EPath _ RegisterRoot [registerField]) =-      commandField == fieldName && registerField == fieldName+      commandField == name && registerField == name     matchingPaths _ _ = False  sampleValue :: Agg -> Text -> ResolvedAggregateType -> Text-sampleValue a fieldName ty = case ty of+sampleValue a name ty = case ty of   AggregateNominal nominal-    | GeneratedNominal <- resolvedNominalOwnership nominal,+    | GeneratedNominal <- (.ownership) nominal,       Just _ <- generatedIdSampleHaskell a nominal ->         generatedIdSampleName nominal   AggregateNominal nominal-    | ConsumerNominal binding <- resolvedNominalOwnership nominal ->+    | ConsumerNominal binding <- (.ownership) nominal ->         "(nominalFixtureDomain (NonEmpty.head (nominalFixtureCases "-          <> renderHarnessReference a (harnessQualifiedValueReference (consumerNominalFixtures binding))+          <> renderHarnessReference a (harnessQualifiedValueReference ((.fixtures) binding))           <> ")))"   AggregateTime -> harnessTimeSampleName a   _ -> fallback   where     fallback = case fieldCat a ty of-      IdCat -> aggregateSampleHaskell (aSymbols a) fieldName ty-      EnumCat -> aggregateSampleHaskell (aSymbols a) fieldName ty-      MappedStructuralCat declaration _ -> fixtureSample a (sdFixtures declaration)-      MappedOpaqueCat declaration -> fixtureSample a (odFixtures declaration)+      IdCat -> aggregateSampleHaskell ((.symbols) a) name ty+      EnumCat -> aggregateSampleHaskell ((.symbols) a) name ty+      MappedStructuralCat declaration _ -> fixtureSample a ((.fixtures) declaration)+      MappedOpaqueCat declaration -> fixtureSample a ((.fixtures) declaration)       OtherCat -> case ty of         AggregateVertex vertexType-          | vertexType == aVertexType a -> initialVertex a-        _ -> aggregateSampleHaskell (aSymbols a) fieldName ty+          | vertexType == (.vertexType) a -> initialVertex a+        _ -> aggregateSampleHaskell ((.symbols) a) name ty  generatedIdSampleName :: ResolvedNominalType -> Text-generatedIdSampleName nominal = "sample" <> resolvedNominalName nominal+generatedIdSampleName nominal = "sample" <> (.name) nominal  harnessUsesTime :: Agg -> Bool harnessUsesTime aggregate =-  any ((== AggregateTime) . snd) (concatMap rcFields (aCommands aggregate <> aEvents aggregate))+  any ((== AggregateTime) . snd) (concatMap (.fields) ((.commands) aggregate <> (.events) aggregate))  harnessTimeSampleName :: Agg -> Text harnessTimeSampleName aggregate-  | any isObservedAtTime (concatMap rcFields (aCommands aggregate <> aEvents aggregate)) = "sampleObservedAt"+  | any isObservedAtTime (concatMap (.fields) ((.commands) aggregate <> (.events) aggregate)) = "sampleObservedAt"   | otherwise = "sampleTime"   where-    isObservedAtTime (identity, resolvedType) = fieldDslName identity == "observedAt" && resolvedType == AggregateTime+    isObservedAtTime (identity, resolvedType) = (.dslName) identity == "observedAt" && resolvedType == AggregateTime  aggregateHarnessImports :: Agg -> [Text] aggregateHarnessImports aggregate@@ -1124,7 +1124,7 @@                then []                else ["import Data.KindID qualified as KindID", "import Data.Text qualified as T", "import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)"]            )-        <> ["import " <> nominalProjectionModule (aContext aggregate) <> " qualified as NominalProjections" | not (null (nominalScalarHarnessTypes aggregate)) || not (null enforcedIds)]+        <> ["import " <> nominalProjectionModule ((.context) aggregate) <> " qualified as NominalProjections" | not (null (nominalScalarHarnessTypes aggregate)) || not (null enforcedIds)]   where     nominals = consumerNominalHarnessTypes aggregate     enforcedIds = enforcedConsumerNominalIdHarnessTypes aggregate@@ -1135,30 +1135,30 @@ consumerNominalHarnessTypes :: Agg -> [ResolvedNominalType] consumerNominalHarnessTypes aggregate =   Map.elems . Map.fromList $-    [ (resolvedNominalName nominal, nominal)-    | resolvedType <- map snd (concatMap rcFields (aCommands aggregate <> aEvents aggregate)) <> map rrType (aRegs aggregate),+    [ ((.name) nominal, nominal)+    | resolvedType <- map snd (concatMap (.fields) ((.commands) aggregate <> (.events) aggregate)) <> map (.valueType) ((.regs) aggregate),       AggregateNominal nominal <- [resolvedType],-      ConsumerNominal {} <- [resolvedNominalOwnership nominal]+      ConsumerNominal {} <- [(.ownership) nominal]     ]  generatedNominalHarnessTypes :: Agg -> [ResolvedNominalType] generatedNominalHarnessTypes aggregate =   generatedNominalsInTypes-    (map snd (concatMap rcFields (aCommands aggregate <> aEvents aggregate)))+    (map snd (concatMap (.fields) ((.commands) aggregate <> (.events) aggregate)))  nominalScalarHarnessTypes :: Agg -> [ResolvedNominalType] nominalScalarHarnessTypes aggregate =   [ nominal   | nominal <- consumerNominalHarnessTypes aggregate,-    ScalarRepresentation {} <- [resolvedNominalRepresentation nominal]+    ScalarRepresentation {} <- [(.representation) nominal]   ]  enforcedConsumerNominalIdHarnessTypes :: Agg -> [ResolvedNominalType] enforcedConsumerNominalIdHarnessTypes aggregate =   [ nominal   | nominal <- consumerNominalHarnessTypes aggregate,-    IdRepresentation prefix <- [resolvedNominalRepresentation nominal],-    idDomainContractFor (aLanguageContract aggregate) prefix /= Nothing+    IdRepresentation prefix <- [(.representation) nominal],+    idDomainContractFor ((.languageContract) aggregate) prefix /= Nothing   ]  nominalHarnessDeclarations :: Agg -> [Text]@@ -1173,7 +1173,7 @@   where     nominals = consumerNominalHarnessTypes aggregate     assertions = concatMap assertionsFor nominals-    assertionsFor nominal = case resolvedNominalOwnership nominal of+    assertionsFor nominal = case (.ownership) nominal of       GeneratedNominal -> []       ConsumerNominal binding ->         [ ( "nominal domain law: " <> name,@@ -1191,17 +1191,17 @@                    <> ") (nominalFixtureDomain fixture)) "                    <> fixtures                )-             | ScalarRepresentation {} <- [resolvedNominalRepresentation nominal]+             | ScalarRepresentation {} <- [(.representation) nominal]              ]           <> idDomainAssertions name bindingName fixtures nominal         where-          name = resolvedNominalName nominal-          bindingName = renderHarnessReference aggregate (harnessQualifiedValueReference (consumerNominalBinding binding))-          fixtureName = renderHarnessReference aggregate (harnessQualifiedValueReference (consumerNominalFixtures binding))+          name = (.name) nominal+          bindingName = renderHarnessReference aggregate (harnessQualifiedValueReference ((.binding) binding))+          fixtureName = renderHarnessReference aggregate (harnessQualifiedValueReference ((.fixtures) binding))           fixtures = "(NonEmpty.toList (nominalFixtureCases " <> fixtureName <> "))"-    idDomainAssertions name bindingName fixtures nominal = case resolvedNominalRepresentation nominal of+    idDomainAssertions name bindingName fixtures nominal = case (.representation) nominal of       IdRepresentation prefix-        | Just contract <- idDomainContractFor (aLanguageContract aggregate) prefix ->+        | Just contract <- idDomainContractFor ((.languageContract) aggregate) prefix ->             let firstSample = idDomainSampleText contract                 samples = [firstSample, T.dropEnd 1 firstSample <> "r"]                 wrongPrefix = "wrong_" <> T.drop (T.length prefix + 1) firstSample@@ -1275,7 +1275,7 @@ mappedCodecHarnessExports :: Agg -> Text mappedCodecHarnessExports aggregate =   T.concat-    [ ", encode" <> sdName declaration <> "Mapped, decode" <> sdName declaration <> "Mapped"+    [ ", encode" <> (.name) declaration <> "Mapped, decode" <> (.name) declaration <> "Mapped"     | ResolvedStructural declaration _ <- codecMappedDeclarations aggregate     ] @@ -1295,13 +1295,13 @@     id     ( planHaskellImports         ImportEnvironment-          { targetModule = aGenPrefix aggregate <> ".Harness",+          { targetModule = (.genPrefix) aggregate <> ".Harness",             localNames =               Set.fromList-                [ aName aggregate <> "Command",-                  aName aggregate <> "Event",-                  aName aggregate <> "Regs",-                  aVertexType aggregate+                [ (.name) aggregate <> "Command",+                  (.name) aggregate <> "Event",+                  (.name) aggregate <> "Regs",+                  (.vertexType) aggregate                 ],             reservedQualifiers = harnessReservedQualifiers           }@@ -1312,13 +1312,13 @@       Set.fromList         [ reference         | nominal <- consumerNominalHarnessTypes aggregate,-          ConsumerNominal binding <- [resolvedNominalOwnership nominal],+          ConsumerNominal binding <- [(.ownership) nominal],           reference <-             map               harnessQualifiedValueReference-              ( consumerNominalBinding binding-                  : consumerNominalFixtures binding-                  : maybeToListHarness (consumerNominalInitial binding)+              ( (.binding) binding+                  : (.fixtures) binding+                  : maybeToListHarness ((.initial) binding)               )         ]     mappedReferences =@@ -1329,11 +1329,11 @@             ResolvedStructural structural _ ->               map                 harnessQualifiedValueReference-                (sdFixtures structural : maybeToListHarness (sdInitial structural))+                ((.fixtures) structural : maybeToListHarness ((.initial) structural))             ResolvedOpaque opaque ->               map                 harnessQualifiedValueReference-                (odFixtures opaque : maybeToListHarness (odInitial opaque))+                ((.fixtures) opaque : maybeToListHarness ((.initial) opaque))         ]     references = consumerNominalReferences <> mappedReferences @@ -1374,20 +1374,20 @@   not (null (mappedEventFields aggregate)) || not (null (structuralWireDeclarations aggregate))  mappedHarnessDeclarationsResolved :: Agg -> [ResolvedMappedDecl]-mappedHarnessDeclarationsResolved aggregate = case aTypeGraph aggregate of+mappedHarnessDeclarationsResolved aggregate = case (.typeGraph) aggregate of   Nothing -> []   Just graph ->     [ declaration-    | key <- aggregateMappedClosure (semanticImpact graph) (aName aggregate),-      Just declaration <- [Map.lookup key (tgDeclarations graph)]+    | key <- aggregateMappedClosure (semanticImpact graph) ((.name) aggregate),+      Just declaration <- [Map.lookup key ((.declarations) graph)]     ]  mappedEventFields :: Agg -> [(ResolvedCtor, Text, ResolvedAggregateType, ResolvedMappedDecl)] mappedEventFields aggregate =-  [ (event, fieldDslName identity, fieldType, declaration)-  | event <- aEvents aggregate,-    (identity, fieldType) <- rcFields event,-    declaration <- maybeToListHarness (mappedDeclaration aggregate fieldType)+  [ (event, (.dslName) identity, valueType, declaration)+  | event <- (.events) aggregate,+    (identity, valueType) <- (.fields) event,+    declaration <- maybeToListHarness (mappedDeclaration aggregate valueType)   ]  structuralWireDeclarations :: Agg -> [(StructuralDecl, ResolvedMappedShape)]@@ -1412,8 +1412,8 @@     structuralWire = structuralWireDeclarations aggregate     eventFields = mappedEventFields aggregate     assertionLists =-      [ mappedEventAssertionName event fieldName <> "Assertions"-      | (event, fieldName, _, _) <- eventFields+      [ mappedEventAssertionName event name <> "Assertions"+      | (event, name, _, _) <- eventFields       ]         <> ["structuralWirePolicyAssertions" | not (null structuralWire)] @@ -1422,25 +1422,25 @@   key <- case resolvedType of     AggregateMapped mappedKey -> Just mappedKey     _ -> Nothing-  graph <- aTypeGraph aggregate-  Map.lookup key (tgDeclarations graph)+  graph <- (.typeGraph) aggregate+  Map.lookup key ((.declarations) graph)  mappedEventAssertionDecl :: Agg -> (ResolvedCtor, Text, ResolvedAggregateType, ResolvedMappedDecl) -> [Text]-mappedEventAssertionDecl aggregate (event, fieldName, _fieldType, declaration) =+mappedEventAssertionDecl aggregate (event, name, _fieldType, declaration) =   [ "",     valueName <> "Assertions :: [(String, Bool)]",     valueName <> "Assertions =",-    "  [ (\"mapped codec round-trip: " <> rcName event <> "/" <> fieldName <> "/\" <> T.unpack label, roundTrips " <> eventExpression <> ")",+    "  [ (\"mapped codec round-trip: " <> (.name) event <> "/" <> name <> "/\" <> T.unpack label, roundTrips " <> eventExpression <> ")",     "  | (label, mappedValue) <- NonEmpty.toList (fixtureCases " <> fixtures <> ")",     "  ]"   ]   where-    valueName = mappedEventAssertionName event fieldName+    valueName = mappedEventAssertionName event name     fixtures = renderHarnessReference aggregate (harnessQualifiedValueReference (mappedFixtures declaration))-    eventExpression = ctorExprWithOverride aggregate event fieldName "mappedValue"+    eventExpression = ctorExprWithOverride aggregate event name "mappedValue"  mappedEventAssertionName :: ResolvedCtor -> Text -> Text-mappedEventAssertionName event fieldName = lowerFirst (rcName event) <> pascal fieldName+mappedEventAssertionName event name = lowerFirst ((.name) event) <> pascal name  wirePolicyAssertionDecls :: Agg -> [(StructuralDecl, ResolvedMappedShape)] -> [Text] wirePolicyAssertionDecls _aggregate [] = []@@ -1457,28 +1457,28 @@ wirePolicyAssertions :: Agg -> (StructuralDecl, ResolvedMappedShape) -> [Text] wirePolicyAssertions aggregate (declaration, shape) = case shape of   RRecord _ unknownFields fields ->-    concatMap (recordMissingAssertions aggregate declaration) [field | field <- fields, rwfPresence field == POptional]+    concatMap (recordMissingAssertions aggregate declaration) [field | field <- fields, (.presence) field == POptional]       <> [unknownFieldAssertion aggregate declaration unknownFields]   REnum entries -> map (enumArmAssertion aggregate declaration) entries <> [enumUnknownAssertion declaration]   RUnion encoding arms ->     map (unionArmAssertion aggregate declaration encoding) arms-      <> [unknownFieldAssertion aggregate declaration (ueUnknownFields encoding)]+      <> [unknownFieldAssertion aggregate declaration ((.unknownFields) encoding)]  wirePoliciesUseIsLeft :: [(StructuralDecl, ResolvedMappedShape)] -> Bool wirePoliciesUseIsLeft = any $ \(_, shape) -> case shape of   RRecord _ unknownFields fields ->     unknownFields == RejectUnknown-      || any (\field -> rwfPresence field == POptional && not (isOptionalType (rwfType field))) fields+      || any (\field -> (.presence) field == POptional && not (isOptionalType ((.valueType) field))) fields   REnum {} -> True-  RUnion encoding _ -> ueUnknownFields encoding == RejectUnknown+  RUnion encoding _ -> (.unknownFields) encoding == RejectUnknown  wirePoliciesUseIsRight :: [(StructuralDecl, ResolvedMappedShape)] -> Bool wirePoliciesUseIsRight = any $ \(_, shape) -> case shape of   RRecord _ unknownFields fields ->     unknownFields == IgnoreUnknown-      || any (\field -> rwfPresence field == POptional && isOptionalType (rwfType field)) fields+      || any (\field -> (.presence) field == POptional && isOptionalType ((.valueType) field)) fields   REnum {} -> False-  RUnion encoding _ -> ueUnknownFields encoding == IgnoreUnknown+  RUnion encoding _ -> (.unknownFields) encoding == IgnoreUnknown  isOptionalType :: ResolvedTypeExpr -> Bool isOptionalType ROptional {} = True@@ -1489,15 +1489,15 @@   [ "(\"wire policy missing default: "       <> canonical       <> "/"-      <> rwfKey field+      <> (.key) field       <> "\", case "       <> decoder       <> " (deleteObjectField "-      <> tshow (rwfKey field)+      <> tshow ((.key) field)       <> " ("       <> encodedSample       <> ")) of Left _ -> False; Right decoded -> objectField "-      <> tshow (rwfKey field)+      <> tshow ((.key) field)       <> " ("       <> encoder       <> " decoded) == Just ("@@ -1506,39 +1506,39 @@     "(\"wire policy explicit null: "       <> canonical       <> "/"-      <> rwfKey field+      <> (.key) field       <> "\", "       <> nullExpectation       <> " ("       <> decoder       <> " (insertObjectField "-      <> tshow (rwfKey field)+      <> tshow ((.key) field)       <> " Aeson.Null ("       <> encodedSample       <> "))))"   ]   where-    canonical = unCanonicalTypeId (sdCanonical declaration)-    encoder = "encode" <> sdName declaration <> "Mapped"-    decoder = "decode" <> sdName declaration <> "Mapped"-    fixtures = renderHarnessReference aggregate (harnessQualifiedValueReference (sdFixtures declaration))+    canonical = unCanonicalTypeId ((.canonical) declaration)+    encoder = "encode" <> (.name) declaration <> "Mapped"+    decoder = "decode" <> (.name) declaration <> "Mapped"+    fixtures = renderHarnessReference aggregate (harnessQualifiedValueReference ((.fixtures) declaration))     encodedSample = encoder <> " (snd (NonEmpty.head (fixtureCases " <> fixtures <> ")))"-    nullExpectation = case rwfType field of+    nullExpectation = case (.valueType) field of       ROptional _ -> "isRight"       _ -> "isLeft"  missingExpectedValue :: Agg -> ResolvedWireField -> Text-missingExpectedValue aggregate field = case rwfOnMissing field of+missingExpectedValue aggregate field = case (.onMissing) field of   Just OmNull -> "Aeson.Null"   Just (OmText value) -> "Aeson.String " <> tshow value   Just (OmInt value) -> "Aeson.toJSON (" <> T.pack (show value) <> " :: Int)"   Just (OmBool value) -> if value then "Aeson.Bool True" else "Aeson.Bool False"   Just OmEmptyList -> "Aeson.toJSON ([] :: [Aeson.Value])"   Just OmEmptyMap -> "Aeson.Object mempty"-  Just (OmCtor constructor) -> case (aTypeGraph aggregate, rwfType field) of-    (Just graph, RRef key) -> case Map.lookup key (tgDeclarations graph) of-      Just (ResolvedStructural _ (REnum entries)) -> case find ((== constructor) . weCtor) entries of-        Just entry -> "Aeson.String " <> tshow (weTag entry)+  Just (OmCtor constructor) -> case ((.typeGraph) aggregate, (.valueType) field) of+    (Just graph, RRef key) -> case Map.lookup key ((.declarations) graph) of+      Just (ResolvedStructural _ (REnum entries)) -> case find ((== constructor) . (.ctor)) entries of+        Just entry -> "Aeson.String " <> tshow ((.tag) entry)         Nothing -> "error \"missing enum default constructor\""       _ -> "error \"non-enum constructor default\""     _ -> "error \"non-reference constructor default\""@@ -1547,15 +1547,15 @@ unknownFieldAssertion :: Agg -> StructuralDecl -> UnknownFields -> Text unknownFieldAssertion aggregate declaration policy =   "(\"wire policy unknown fields: "-    <> unCanonicalTypeId (sdCanonical declaration)+    <> unCanonicalTypeId ((.canonical) declaration)     <> "\", all (\\(_, value) -> "     <> expectation     <> " (decode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped (insertObjectField \"__keiro_unknown\" (Aeson.Bool True) (encode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped value)))) (NonEmpty.toList (fixtureCases "-    <> renderHarnessReference aggregate (harnessQualifiedValueReference (sdFixtures declaration))+    <> renderHarnessReference aggregate (harnessQualifiedValueReference ((.fixtures) declaration))     <> ")))"   where     expectation = case policy of@@ -1565,47 +1565,47 @@ enumArmAssertion :: Agg -> StructuralDecl -> WireEnum -> Text enumArmAssertion aggregate declaration entry =   "(\"wire enum arm: "-    <> unCanonicalTypeId (sdCanonical declaration)+    <> unCanonicalTypeId ((.canonical) declaration)     <> "/"-    <> weTag entry+    <> (.tag) entry     <> "\", any (\\(_, value) -> encode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped value == Aeson.String "-    <> tshow (weTag entry)+    <> tshow ((.tag) entry)     <> " && decode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped (Aeson.String "-    <> tshow (weTag entry)+    <> tshow ((.tag) entry)     <> ") == Right value) (NonEmpty.toList (fixtureCases "-    <> renderHarnessReference aggregate (harnessQualifiedValueReference (sdFixtures declaration))+    <> renderHarnessReference aggregate (harnessQualifiedValueReference ((.fixtures) declaration))     <> ")))"  enumUnknownAssertion :: StructuralDecl -> Text enumUnknownAssertion declaration =   "(\"wire enum unknown tag: "-    <> unCanonicalTypeId (sdCanonical declaration)+    <> unCanonicalTypeId ((.canonical) declaration)     <> "\", isLeft (decode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped (Aeson.String \"__keiro_unknown\")))"  unionArmAssertion :: Agg -> StructuralDecl -> UnionEncoding -> ResolvedWireArm -> Text unionArmAssertion aggregate declaration encoding arm =   "(\"wire union arm: "-    <> unCanonicalTypeId (sdCanonical declaration)+    <> unCanonicalTypeId ((.canonical) declaration)     <> "/"-    <> rwaTag arm+    <> (.tag) arm     <> "\", any (\\(_, value) -> objectField "-    <> tshow (ueTagField encoding)+    <> tshow ((.tagField) encoding)     <> " (encode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped value) == Just (Aeson.String "-    <> tshow (rwaTag arm)+    <> tshow ((.tag) arm)     <> ") && decode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped (encode"-    <> sdName declaration+    <> (.name) declaration     <> "Mapped value) == Right value) (NonEmpty.toList (fixtureCases "-    <> renderHarnessReference aggregate (harnessQualifiedValueReference (sdFixtures declaration))+    <> renderHarnessReference aggregate (harnessQualifiedValueReference ((.fixtures) declaration))     <> ")))"  wirePolicyHelpers :: [(StructuralDecl, ResolvedMappedShape)] -> [Text]@@ -1637,23 +1637,23 @@   where     usesDelete = any hasOptionalRecordField declarations     usesObjectField = usesDelete || any isUnion declarations-    hasOptionalRecordField (_, RRecord _ _ fields) = any ((== POptional) . rwfPresence) fields+    hasOptionalRecordField (_, RRecord _ _ fields) = any ((== POptional) . (.presence)) fields     hasOptionalRecordField _ = False     isUnion (_, RUnion {}) = True     isUnion _ = False  mappedFixtures :: ResolvedMappedDecl -> QualifiedValueName-mappedFixtures (ResolvedStructural declaration _) = sdFixtures declaration-mappedFixtures (ResolvedOpaque declaration) = odFixtures declaration+mappedFixtures (ResolvedStructural declaration _) = (.fixtures) declaration+mappedFixtures (ResolvedOpaque declaration) = (.fixtures) declaration  ctorExprWithOverride :: Agg -> ResolvedCtor -> Text -> Text -> Text ctorExprWithOverride aggregate constructor target replacement =-  "(" <> rcName constructor <> " (" <> rcName constructor <> "Data" <> arguments <> "))"+  "(" <> (.name) constructor <> " (" <> (.name) constructor <> "Data" <> arguments <> "))"   where     arguments =       T.concat-        [ " " <> if fieldDslName identity == target then replacement else sampleValue aggregate (fieldDslName identity) fieldType-        | (identity, fieldType) <- rcFields constructor+        [ " " <> if (.dslName) identity == target then replacement else sampleValue aggregate ((.dslName) identity) valueType+        | (identity, valueType) <- (.fields) constructor         ]  maybeToListHarness :: Maybe value -> [value]

src/Keiro/Dsl/HaskellImport.hs view

@@ -38,10 +38,10 @@   deriving stock (Eq, Ord, Show)  data HaskellReference = HaskellReference-  { referenceModule :: !Text,-    referenceName :: !Text,-    referenceNamespace :: !HaskellNamespace,-    referenceQualification :: !QualificationPreference+  { moduleName :: !Text,+    name :: !Text,+    namespace :: !HaskellNamespace,+    qualification :: !QualificationPreference   }   deriving stock (Eq, Ord, Show) @@ -61,9 +61,9 @@   deriving stock (Eq, Show)  data HaskellImportPlan = HaskellImportPlan-  { importPlanTargetModule :: !Text,-    importPlanDeclarations :: !(Set Text),-    importPlanReferences :: !(Map HaskellReference Text)+  { targetModule :: !Text,+    declarations :: !(Set Text),+    references :: !(Map HaskellReference Text)   }  planHaskellImports :: ImportEnvironment -> Set HaskellReference -> Either HaskellImportError HaskellImportPlan@@ -74,35 +74,35 @@   plannedReferences <- Map.fromList <$> traverse (renderReference aliases) orderedReferences   pure     HaskellImportPlan-      { importPlanTargetModule = target,-        importPlanDeclarations = explicitDeclarations <> qualifiedDeclarations aliases,-        importPlanReferences = plannedReferences+      { targetModule = target,+        declarations = explicitDeclarations <> qualifiedDeclarations aliases,+        references = plannedReferences       }   where-    target = targetModule environment+    target = (.targetModule) environment     orderedReferences = Set.toAscList references     occurrenceOwners =       Map.fromListWith         (<>)-        [ (referenceName reference, Set.singleton (referenceModule reference, referenceName reference))+        [ ((.name) reference, Set.singleton ((.moduleName) reference, (.name) reference))         | reference <- orderedReferences,-          referenceNamespace reference == TypeNamespace,-          referenceQualification reference == PreferUnqualified+          (.namespace) reference == TypeNamespace,+          (.qualification) reference == PreferUnqualified         ]     unqualified reference =-      referenceNamespace reference == TypeNamespace-        && referenceQualification reference == PreferUnqualified-        && Set.notMember (referenceName reference) (localNames environment)-        && Set.notMember (referenceName reference) (reservedQualifiers environment)-        && maybe False ((== 1) . Set.size) (Map.lookup (referenceName reference) occurrenceOwners)+      (.namespace) reference == TypeNamespace+        && (.qualification) reference == PreferUnqualified+        && Set.notMember ((.name) reference) ((.localNames) environment)+        && Set.notMember ((.name) reference) ((.reservedQualifiers) environment)+        && maybe False ((== 1) . Set.size) (Map.lookup ((.name) reference) occurrenceOwners)     unqualifiedReferences = Set.filter unqualified references-    unqualifiedNames = Set.map referenceName unqualifiedReferences+    unqualifiedNames = Set.map (.name) unqualifiedReferences     qualifiedModules =-      Set.map referenceModule (references `Set.difference` unqualifiedReferences)+      Set.map (.moduleName) (references `Set.difference` unqualifiedReferences)     explicitImports =       Map.fromListWith         (<>)-        [ (referenceModule reference, Set.singleton (referenceName reference))+        [ ((.moduleName) reference, Set.singleton ((.name) reference))         | reference <- Set.toAscList unqualifiedReferences         ]     explicitDeclarations =@@ -116,20 +116,20 @@         | (moduleName, alias) <- Map.toAscList aliases         ]     renderReference aliases reference-      | Set.member reference unqualifiedReferences = pure (reference, referenceName reference)-      | otherwise = case Map.lookup (referenceModule reference) aliases of-          Nothing -> Left (ImpossibleHaskellAlias target (Set.singleton (referenceModule reference)))-          Just alias -> pure (reference, alias <> "." <> referenceName reference)+      | Set.member reference unqualifiedReferences = pure (reference, (.name) reference)+      | otherwise = case Map.lookup ((.moduleName) reference) aliases of+          Nothing -> Left (ImpossibleHaskellAlias target (Set.singleton ((.moduleName) reference)))+          Just alias -> pure (reference, alias <> "." <> (.name) reference)  renderPlannedImports :: HaskellImportPlan -> Text-renderPlannedImports = T.intercalate "\n" . Set.toAscList . importPlanDeclarations+renderPlannedImports = T.intercalate "\n" . Set.toAscList . (.declarations)  renderPlannedReference :: HaskellImportPlan -> HaskellReference -> Either HaskellImportError Text renderPlannedReference plan reference =   maybe-    (Left (MissingHaskellReference (importPlanTargetModule plan) reference))+    (Left (MissingHaskellReference ((.targetModule) plan) reference))     Right-    (Map.lookup reference (importPlanReferences plan))+    (Map.lookup reference ((.references) plan))  allocateAliases :: ImportEnvironment -> Set Text -> Set Text -> Either HaskellImportError (Map Text Text) allocateAliases environment unqualifiedNames modules = do@@ -141,7 +141,7 @@           | (moduleName, candidates) <- Map.toAscList moduleCandidates,             candidate <- candidates           ]-      occupied = reservedQualifiers environment <> localNames environment <> unqualifiedNames+      occupied = (.reservedQualifiers) environment <> (.localNames) environment <> unqualifiedNames       choose moduleName candidates =         case find (isAvailable moduleName candidateOwners occupied) candidates of           Just candidate -> candidate@@ -161,7 +161,7 @@           ]   if Set.null impossibleModules     then pure aliases-    else Left (ImpossibleHaskellAlias (targetModule environment) impossibleModules)+    else Left (ImpossibleHaskellAlias ((.targetModule) environment) impossibleModules)  isAvailable :: Text -> Map Text (Set Text) -> Set Text -> Text -> Bool isAvailable moduleName candidateOwners occupied candidate =@@ -183,13 +183,13 @@  validateReference :: Text -> HaskellReference -> Either HaskellImportError () validateReference target reference = do-  validateModuleName target (referenceModule reference)-  if referenceModule reference == target+  validateModuleName target ((.moduleName) reference)+  if (.moduleName) reference == target     then Left (HaskellSelfImport target)     else pure ()-  if validOccurrence (referenceNamespace reference) (referenceName reference)+  if validOccurrence ((.namespace) reference) ((.name) reference)     then pure ()-    else Left (InvalidHaskellOccurrence target (referenceNamespace reference) (referenceName reference))+    else Left (InvalidHaskellOccurrence target ((.namespace) reference) ((.name) reference))  validateModuleName :: Text -> Text -> Either HaskellImportError () validateModuleName target candidate

src/Keiro/Dsl/HaskellName.hs view

@@ -93,10 +93,10 @@ -- | The source declaration responsible for a generated occurrence.  The -- owner and kind form a stable identity; the line is evidence, not identity. data NameSite = NameSite-  { siteKind :: !NameSiteKind,-    siteLogicalName :: !Text,-    siteOwner :: !Text,-    siteLine :: !Int+  { kind :: !NameSiteKind,+    logicalName :: !Text,+    owner :: !Text,+    line :: !Int   }   deriving stock (Eq, Ord, Show) @@ -105,16 +105,16 @@ -- normally empty; record fields use their owning record so -- DuplicateRecordFields can keep identical selectors on different records. data HaskellOccurrenceKey = HaskellOccurrenceKey-  { occurrenceModule :: !Text,-    occurrenceSpace :: !HaskellOccurrenceSpace,-    occurrenceScope :: !Text,-    occurrenceName :: !Text+  { moduleName :: !Text,+    space :: !HaskellOccurrenceSpace,+    scope :: !Text,+    name :: !Text   }   deriving stock (Eq, Ord, Show)  data PlannedOccurrence = PlannedOccurrence-  { plannedOccurrenceKey :: !HaskellOccurrenceKey,-    plannedOccurrenceSite :: !NameSite+  { key :: !HaskellOccurrenceKey,+    site :: !NameSite   }   deriving stock (Eq, Ord, Show) @@ -129,20 +129,23 @@ data GeneratedHaskellNamingEdition   = LegacyNamingV1   | IdiomaticNamingV1+  | IdiomaticNamingV2   deriving stock (Eq, Ord, Show)  currentGeneratedHaskellNamingEdition :: GeneratedHaskellNamingEdition-currentGeneratedHaskellNamingEdition = IdiomaticNamingV1+currentGeneratedHaskellNamingEdition = IdiomaticNamingV2  renderGeneratedHaskellNamingEdition :: GeneratedHaskellNamingEdition -> Text renderGeneratedHaskellNamingEdition = \case   LegacyNamingV1 -> "legacy-v1"   IdiomaticNamingV1 -> "idiomatic-v1"+  IdiomaticNamingV2 -> "idiomatic-v2"  parseGeneratedHaskellNamingEdition :: Text -> Maybe GeneratedHaskellNamingEdition parseGeneratedHaskellNamingEdition = \case   "legacy-v1" -> Just LegacyNamingV1   "idiomatic-v1" -> Just IdiomaticNamingV1+  "idiomatic-v2" -> Just IdiomaticNamingV2   _ -> Nothing  renderUpperCamelName :: UpperCamelName -> Text@@ -162,7 +165,7 @@ -- below and are intentionally never re-cased here. deriveHaskellName :: NameSourceKind -> NameSite -> Either HaskellNameError DerivedHaskellName deriveHaskellName source site-  | source == ExplicitHaskellName = Left (InvalidExplicitHaskellName site (siteLogicalName site))+  | source == ExplicitHaskellName = Left (InvalidExplicitHaskellName site ((.logicalName) site))   | otherwise = do       words' <- segmentLogicalName (source == LogicalWireWord) site       case words' of@@ -181,7 +184,7 @@ deriveLowerHelperName :: NameSourceKind -> Text -> NameSite -> Either HaskellNameError LowerCamelName deriveLowerHelperName source suffix site = do   derived <- deriveHaskellName source site-  checkedLowerOccurrence site (renderLowerCamelName (lowerCamel derived) <> suffix)+  checkedLowerOccurrence site (renderLowerCamelName ((.lowerCamel) derived) <> suffix)  checkedModuleSegment :: NameSite -> Text -> Either HaskellNameError HaskellModuleSegment checkedModuleSegment site candidate@@ -212,16 +215,16 @@ plannedOccurrence :: Text -> HaskellOccurrenceSpace -> Text -> Text -> NameSite -> PlannedOccurrence plannedOccurrence targetModule space scope rendered site =   PlannedOccurrence-    { plannedOccurrenceKey =+    { key =         HaskellOccurrenceKey-          { occurrenceModule = T.toCaseFold targetModule,-            occurrenceSpace = space,-            occurrenceScope = T.toCaseFold scope,-            occurrenceName = case space of+          { moduleName = T.toCaseFold targetModule,+            space = space,+            scope = T.toCaseFold scope,+            name = case space of               ModuleSpace -> T.toCaseFold rendered               _ -> rendered           },-      plannedOccurrenceSite = site+      site = site     }  -- | Report deterministic collisions independently of declaration traversal@@ -238,8 +241,8 @@       Map.filter ((> 1) . Set.size) $         Map.fromListWith           Set.union-          [ (plannedOccurrenceKey occurrence, Set.singleton (plannedOccurrenceSite occurrence))-          | occurrence <- sortOn plannedOccurrenceKey occurrences+          [ ((.key) occurrence, Set.singleton ((.site) occurrence))+          | occurrence <- sortOn (.key) occurrences           ]  segmentLogicalName :: Bool -> NameSite -> Either HaskellNameError [Text]@@ -251,7 +254,7 @@   | any T.null separated = Left (EmptyNameSegment site)   | otherwise = Right (concatMap splitCamelWord separated)   where-    raw = siteLogicalName site+    raw = (.logicalName) site     badUnderscore =       T.isPrefixOf "_" raw         || T.isSuffixOf "_" raw

src/Keiro/Dsl/HaskellSourceMove.hs view

@@ -21,24 +21,24 @@ import Data.Text.Encoding qualified as TE import Data.Word (Word64, Word8) import Keiro.Dsl.HaskellName qualified as HaskellName-import Keiro.Dsl.Scaffold (ModuleKind, ModuleRole, ScaffoldModule, modulePath, moduleRole)+import Keiro.Dsl.Scaffold (ModuleKind, ModuleRole, ScaffoldModule (..), moduleRole) import Numeric (showHex)  data SourceMove = SourceMove-  { moveRole :: !ModuleRole,-    moveKind :: !ModuleKind,-    moveOldModule :: !Text,-    moveNewModule :: !Text,-    moveOldPath :: !FilePath,-    moveNewPath :: !FilePath,-    moveBackupPath :: !FilePath,+  { role :: !ModuleRole,+    kind :: !ModuleKind,+    oldModule :: !Text,+    newModule :: !Text,+    oldPath :: !FilePath,+    newPath :: !FilePath,+    backupPath :: !FilePath,     -- | Digest of the exact legacy bytes.  Planning cannot populate it because     -- it is pure and filesystem-independent; the complete migration preflight     -- hydrates it before a move is reported or applied.-    moveContentDigest :: !(Maybe Text),+    contentDigest :: !(Maybe Text),     -- | Digest of the token-aware transformed bytes, used with the durable     -- migration state to recognize an installed or prepared crash state.-    moveTransformedDigest :: !(Maybe Text)+    transformedDigest :: !(Maybe Text)   }   deriving stock (Eq, Show) @@ -58,10 +58,10 @@ planSourceMoves previous current =   case errors of     first : rest -> Left (first :| rest)-    [] -> Right (sortOn moveOldPath moves)+    [] -> Right (sortOn (.oldPath) moves)   where     currentByRole = Map.fromListWith (<>) [(moduleRole scaffoldModule, [scaffoldModule]) | scaffoldModule <- current]-    currentByModule = Map.fromListWith (<>) [(moduleNameFromPath (modulePath scaffoldModule), [scaffoldModule]) | scaffoldModule <- current]+    currentByModule = Map.fromListWith (<>) [(moduleNameFromPath ((.path) scaffoldModule), [scaffoldModule]) | scaffoldModule <- current]     planned = map pair previous     errors = [err | Left err <- planned]     moves = [move | Right (Just move) <- planned]@@ -75,28 +75,28 @@       case candidate of         Nothing -> Right Nothing         Just currentModule-          | modulePath currentModule == previousPath -> Right Nothing-          | normalizeLegacyModuleName (moduleNameFromPath previousPath) /= moduleNameFromPath (modulePath currentModule) -> Right Nothing+          | (.path) currentModule == previousPath -> Right Nothing+          | normalizeLegacyModuleName (moduleNameFromPath previousPath) /= moduleNameFromPath ((.path) currentModule) -> Right Nothing           | otherwise ->               Right . Just $                 SourceMove-                  { moveRole = moduleRole currentModule,-                    moveKind = previousKind,-                    moveOldModule = moduleNameFromPath previousPath,-                    moveNewModule = moduleNameFromPath (modulePath currentModule),-                    moveOldPath = previousPath,-                    moveNewPath = modulePath currentModule,-                    moveBackupPath = ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/" <> previousPath,-                    moveContentDigest = Nothing,-                    moveTransformedDigest = Nothing+                  { role = moduleRole currentModule,+                    kind = previousKind,+                    oldModule = moduleNameFromPath previousPath,+                    newModule = moduleNameFromPath ((.path) currentModule),+                    oldPath = previousPath,+                    newPath = (.path) currentModule,+                    backupPath = ".keiro-dsl-name-migrations/legacy-v1-to-idiomatic-v1/" <> previousPath,+                    contentDigest = Nothing,+                    transformedDigest = Nothing                   }      uniqueRole _ [] = Right Nothing     uniqueRole _ [candidate] = Right (Just candidate)-    uniqueRole role candidates = Left (AmbiguousModuleRole role (map modulePath candidates))+    uniqueRole role candidates = Left (AmbiguousModuleRole role (map (.path) candidates))     uniqueLegacy _ [] = Right Nothing     uniqueLegacy _ [candidate] = Right (Just candidate)-    uniqueLegacy path candidates = Left (AmbiguousLegacyModule path (map modulePath candidates))+    uniqueLegacy path candidates = Left (AmbiguousLegacyModule path (map (.path) candidates))  moduleNameFromPath :: FilePath -> Text moduleNameFromPath = T.replace "/" "." . T.dropEnd 3 . T.pack@@ -106,15 +106,15 @@   where     normalizeSegment segment =       case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-        Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)+        Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)         Left _ -> segment       where         site =           HaskellName.NameSite-            { HaskellName.siteKind = HaskellName.NodeModuleSite,-              HaskellName.siteLogicalName = segment,-              HaskellName.siteOwner = "legacy-module-segment",-              HaskellName.siteLine = 0+            { HaskellName.kind = HaskellName.NodeModuleSite,+              HaskellName.logicalName = segment,+              HaskellName.owner = "legacy-module-segment",+              HaskellName.line = 0             }  data LexState

src/Keiro/Dsl/IdDomain.hs view

@@ -20,14 +20,14 @@ import Keiro.Codec.IdDomain import Keiro.Dsl.Grammar (ContractEvent (..), ContractField (..), ContractNode (..), ContractType (..), IdDecl (..), Node (..), Spec (..)) import Keiro.Dsl.LanguageVersion (RuntimeCapability (..), runtimeProfileHasCapability)-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedSpec, effectiveRuntimeProfile)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec)  -- | Versions 1 and 2 intentionally return 'Nothing': their generated IDs -- admitted arbitrary text. Runtime-semantics generation 2 is the first -- enforcing contract. idDomainContractFor :: EffectiveLanguageContract -> Text -> Maybe IdDomainContract idDomainContractFor languageContract prefix-  | runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) GeneratedIdDomainTypeIdV7 =+  | runtimeProfileHasCapability ((.runtimeProfile) languageContract) GeneratedIdDomainTypeIdV7 =       Just (typeIdV7Domain prefix)   | otherwise = Nothing @@ -35,7 +35,7 @@ -- in runtime semantics 3. Aggregate IDs retain the independent selector above. contractIdDomainContractFor :: EffectiveLanguageContract -> Text -> Maybe IdDomainContract contractIdDomainContractFor languageContract prefix-  | runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) ContractIdDomainTypeIdV7 = Just (typeIdV7Domain prefix)+  | runtimeProfileHasCapability ((.runtimeProfile) languageContract) ContractIdDomainTypeIdV7 = Just (typeIdV7Domain prefix)   | otherwise = Nothing  -- | Durable identity for the runtime admission domain of one declaration.@@ -60,15 +60,15 @@     spec = checkedSpec service     languageContract = checkedLanguageContract service     aggregateIdentities =-      [ idDomainIdentity (idName declaration) contract-      | declaration <- specIds spec,-        Just contract <- [idDomainContractFor languageContract (idPrefix declaration)]+      [ idDomainIdentity ((.name) declaration) contract+      | declaration <- (.ids) spec,+        Just contract <- [idDomainContractFor languageContract ((.prefix) declaration)]       ]     contractIdentities =-      [ idDomainIdentity ("contract:" <> ctrName contractNode <> "." <> ceName event <> "." <> cfName field) contract-      | NContract contractNode <- specNodes spec,-        event <- ctrEvents contractNode,-        field <- ceFields event,-        CTypeId prefix <- [cfType field],+      [ idDomainIdentity ("contract:" <> (.name) contractNode <> "." <> (.name) event <> "." <> (.name) field) contract+      | NContract contractNode <- (.nodes) spec,+        event <- (.events) contractNode,+        field <- (.fields) event,+        CTypeId prefix <- [(.valueType) field],         Just contract <- [contractIdDomainContractFor languageContract prefix]       ]

src/Keiro/Dsl/LanguageVersion.hs view

@@ -117,16 +117,16 @@ -- Constructors stay private so a released profile can only be selected from -- the authoritative registry rather than widened ad hoc by parser callers. data SyntaxProfile = SyntaxProfile-  { profileIdentifier :: !Text,-    profileFeatures :: !(Set LanguageFeature)+  { identifier :: !Text,+    features :: !(Set LanguageFeature)   }   deriving stock (Eq, Show, Generic)  syntaxProfileIdentifier :: SyntaxProfile -> Text-syntaxProfileIdentifier SyntaxProfile {profileIdentifier} = profileIdentifier+syntaxProfileIdentifier SyntaxProfile {identifier} = identifier  syntaxProfileSupportsFeature :: SyntaxProfile -> LanguageFeature -> Bool-syntaxProfileSupportsFeature SyntaxProfile {profileFeatures} feature = Set.member feature profileFeatures+syntaxProfileSupportsFeature SyntaxProfile {features} feature = Set.member feature features  -- | One independently selectable runtime behavior in a registered language -- contract. Constructors shipped in a release are append-only; the active@@ -147,17 +147,17 @@ -- constructor stays private so callers select only an authoritative registry -- profile rather than widening runtime behavior ad hoc. data RuntimeSemanticsProfile = RuntimeSemanticsProfile-  { runtimeSemanticsIdentifier :: !Text,-    runtimeSemanticsCapabilities :: !(Set RuntimeCapability)+  { identifier :: !Text,+    capabilities :: !(Set RuntimeCapability)   }   deriving stock (Eq, Ord, Show, Generic)  runtimeProfileIdentifier :: RuntimeSemanticsProfile -> Text-runtimeProfileIdentifier RuntimeSemanticsProfile {runtimeSemanticsIdentifier} = runtimeSemanticsIdentifier+runtimeProfileIdentifier RuntimeSemanticsProfile {identifier} = identifier  runtimeProfileHasCapability :: RuntimeSemanticsProfile -> RuntimeCapability -> Bool-runtimeProfileHasCapability RuntimeSemanticsProfile {runtimeSemanticsCapabilities} capability =-  Set.member capability runtimeSemanticsCapabilities+runtimeProfileHasCapability RuntimeSemanticsProfile {capabilities} capability =+  Set.member capability capabilities  -- | Optional replay-fold identity contributed by one capability.  Duplicate -- tokens intentionally collapse at the profile boundary so the two coupled@@ -172,11 +172,11 @@ capabilityFoldSegment SeparatedProjectionQueryPolicy = Nothing  runtimeProfileFoldSegments :: RuntimeSemanticsProfile -> [Text]-runtimeProfileFoldSegments RuntimeSemanticsProfile {runtimeSemanticsCapabilities} =+runtimeProfileFoldSegments RuntimeSemanticsProfile {capabilities} =   Set.toAscList     ( Set.fromList         [ segment-        | capability <- Set.toAscList runtimeSemanticsCapabilities,+        | capability <- Set.toAscList capabilities,           Just segment <- [capabilityFoldSegment capability]         ]     )@@ -205,22 +205,22 @@ -- | One language-registry entry. Published entries are immutable; an active -- pre-release candidate is not a published compatibility contract yet. data LanguageDefinition = LanguageDefinition-  { definitionVersion :: !LanguageVersion,-    definitionPredecessor :: !(Maybe LanguageVersion),+  { version :: !LanguageVersion,+    predecessor :: !(Maybe LanguageVersion),     -- | Compatibility projection retained for the 0.7 public API. Parser     -- dispatch uses 'definitionSyntaxProfile', never this historical tag.-    definitionBodyParser :: !LanguageBodyParser,-    definitionSyntaxProfile :: !SyntaxProfile,-    definitionRuntimeSemanticsProfile :: !RuntimeSemanticsProfile,-    definitionSupport :: !LanguageSupport,-    definitionMaturity :: !LanguageMaturity+    bodyParser :: !LanguageBodyParser,+    syntaxProfile :: !SyntaxProfile,+    runtimeSemanticsProfile :: !RuntimeSemanticsProfile,+    support :: !LanguageSupport,+    maturity :: !LanguageMaturity   }   deriving stock (Eq, Show, Generic)  -- | Stable compatibility projection used by serialized records and diagnostic -- text.  Runtime behavior must query 'definitionRuntimeSemanticsProfile'. definitionRuntimeSemantics :: LanguageDefinition -> Text-definitionRuntimeSemantics = runtimeProfileIdentifier . definitionRuntimeSemanticsProfile+definitionRuntimeSemantics = runtimeProfileIdentifier . (.runtimeSemanticsProfile)  version1 :: LanguageVersion version1 = LanguageVersion 1@@ -269,7 +269,7 @@     "keiro-dsl/syntax-profile/3"     ( Set.insert         FieldAliasSyntax-        (profileFeatures profileV2)+        ((.features) profileV2)     )  profileV4 :: SyntaxProfile@@ -284,7 +284,7 @@                 DomainCommandOutcomeSyntax                 ( Set.insert                     MappedConsumerSurfaceSyntax-                    (Set.insert ExternalReadContractSyntax (Set.insert ProjectionCatalogSyntax (profileFeatures profileV3)))+                    (Set.insert ExternalReadContractSyntax (Set.insert ProjectionCatalogSyntax ((.features) profileV3)))                 )             )         )@@ -320,17 +320,17 @@     "keiro-dsl/runtime-semantics/4"     ( Set.insert         SeparatedProjectionQueryPolicy-        (Set.insert TypedDomainCommandOutcomes (Set.insert ProjectionCatalogRuntime (runtimeSemanticsCapabilities runtimeProfileV3)))+        (Set.insert TypedDomainCommandOutcomes (Set.insert ProjectionCatalogRuntime ((.capabilities) runtimeProfileV3)))     )  -- | Supported versions, derived from 'languageRegistry'. supportedLanguageVersions :: NonEmpty LanguageVersion-supportedLanguageVersions = definitionVersion <$> languageRegistry+supportedLanguageVersions = (.version) <$> languageRegistry  -- | The one published registry entry recommended for stable sources. currentStableLanguageVersion :: LanguageVersion currentStableLanguageVersion =-  case [definitionVersion definition | definition <- NE.toList languageRegistry, definitionSupport definition == Stable] of+  case [(.version) definition | definition <- NE.toList languageRegistry, (.support) definition == Stable] of     [version] -> version     _ -> error "keiro-dsl internal invariant: language registry must contain exactly one stable version" @@ -339,17 +339,17 @@ -- published; otherwise authoring falls back to the published stable contract. currentAuthoringLanguageVersion :: LanguageVersion currentAuthoringLanguageVersion =-  case [definitionVersion definition | definition <- NE.toList languageRegistry, definitionMaturity definition == CandidateLanguage] of+  case [(.version) definition | definition <- NE.toList languageRegistry, (.maturity) definition == CandidateLanguage] of     [] -> currentStableLanguageVersion     [version] -> version     _ -> error "keiro-dsl internal invariant: language registry must contain at most one candidate version"  languageSupportForVersion :: LanguageVersion -> Maybe LanguageSupport-languageSupportForVersion version = definitionSupport <$> lookupLanguageDefinition version+languageSupportForVersion version = (.support) <$> lookupLanguageDefinition version  lookupLanguageDefinition :: LanguageVersion -> Maybe LanguageDefinition lookupLanguageDefinition version =-  find ((== version) . definitionVersion) (NE.toList languageRegistry)+  find ((== version) . (.version)) (NE.toList languageRegistry)  -- | Grammar-owned syntax introduced after the frozen version-1 contract. -- Keeping these gates beside the released-language registry prevents the@@ -371,20 +371,20 @@ -- | The first released contract that owns each grammar feature. languageFeatureMinimumVersion :: LanguageFeature -> LanguageVersion languageFeatureMinimumVersion feature =-  case find (\definition -> syntaxProfileSupportsFeature (definitionSyntaxProfile definition) feature) (NE.toList languageRegistry) of-    Just definition -> definitionVersion definition+  case find (\definition -> syntaxProfileSupportsFeature ((.syntaxProfile) definition) feature) (NE.toList languageRegistry) of+    Just definition -> (.version) definition     Nothing -> error "keiro-dsl internal invariant: a released language feature has no owning profile"  languageVersionsSupportingFeature :: LanguageFeature -> [LanguageVersion] languageVersionsSupportingFeature feature =-  [ definitionVersion definition+  [ (.version) definition   | definition <- NE.toList languageRegistry,-    syntaxProfileSupportsFeature (definitionSyntaxProfile definition) feature+    syntaxProfileSupportsFeature ((.syntaxProfile) definition) feature   ]  languageSupportsFeature :: LanguageVersion -> LanguageFeature -> Bool languageSupportsFeature version feature =-  maybe False (\definition -> syntaxProfileSupportsFeature (definitionSyntaxProfile definition) feature) (lookupLanguageDefinition version)+  maybe False (\definition -> syntaxProfileSupportsFeature ((.syntaxProfile) definition) feature) (lookupLanguageDefinition version)  effectiveLanguageVersion :: SourceLanguage -> LanguageVersion effectiveLanguageVersion LegacyUnversioned = version1@@ -428,18 +428,18 @@  -- | A source-selection failure with the original member-local source line. data SourceLanguageDiagnostic = SourceLanguageDiagnostic-  { sourceLanguageErrorCode :: !SourceLanguageErrorCode,-    sourceLanguageSource :: !FilePath,-    sourceLanguageLoc :: !Loc,-    sourceLanguageToken :: !(Maybe Text),-    sourceLanguageDeclaredVersion :: !(Maybe LanguageVersion),-    sourceLanguageSupportedVersions :: !(NonEmpty LanguageVersion)+  { errorCode :: !SourceLanguageErrorCode,+    source :: !FilePath,+    loc :: !Loc,+    token :: !(Maybe Text),+    declaredVersion :: !(Maybe LanguageVersion),+    supportedVersions :: !(NonEmpty LanguageVersion)   }   deriving stock (Eq, Show)  renderSourceLanguageDiagnostic :: SourceLanguageDiagnostic -> Text renderSourceLanguageDiagnostic diagnostic =-  T.pack (sourceLanguageSource diagnostic)+  T.pack ((.source) diagnostic)     <> ":"     <> T.pack (show line)     <> ":1: error ["@@ -447,15 +447,15 @@     <> "]: "     <> sourceLanguageDiagnosticMessage diagnostic   where-    Loc line = sourceLanguageLoc diagnostic-    code = sourceLanguageErrorCode diagnostic+    Loc line = (.loc) diagnostic+    code = (.errorCode) diagnostic  sourceLanguageDiagnosticMessage :: SourceLanguageDiagnostic -> Text sourceLanguageDiagnosticMessage diagnostic = detail   where-    code = sourceLanguageErrorCode diagnostic-    supported = T.intercalate ", " (map languageVersionText (NE.toList (sourceLanguageSupportedVersions diagnostic)))-    token = maybe "<missing>" id (sourceLanguageToken diagnostic)+    code = (.errorCode) diagnostic+    supported = T.intercalate ", " (map languageVersionText (NE.toList ((.supportedVersions) diagnostic)))+    token = maybe "<missing>" id ((.token) diagnostic)     detail = case code of       InvalidLanguageVersion ->         "invalid language preamble; expected `language keiro-dsl <positive-decimal>`, found `"@@ -463,7 +463,7 @@           <> "`"       UnsupportedLanguageVersion ->         "declared keiro-dsl language version "-          <> maybe token languageVersionText (sourceLanguageDeclaredVersion diagnostic)+          <> maybe token languageVersionText ((.declaredVersion) diagnostic)           <> " is unsupported; supported versions: "           <> supported       DuplicateLanguagePreamble ->@@ -474,34 +474,34 @@         "selected syntax requires keiro-dsl language version "           <> languageVersionText requiredVersion           <> "; selected version "-          <> maybe token languageVersionText (sourceLanguageDeclaredVersion diagnostic)+          <> maybe token languageVersionText ((.declaredVersion) diagnostic)         where           requiredVersion =             case reverse publishedCompatibilityVersions of               latestCompatibility : _ -> latestCompatibility               [] -> case reverse publishedVersions of                 latestPublished : _ -> latestPublished-                [] -> NE.last (sourceLanguageSupportedVersions diagnostic)+                [] -> NE.last ((.supportedVersions) diagnostic)           supportedDefinitions =             [ (version, definition)-            | version <- NE.toList (sourceLanguageSupportedVersions diagnostic),+            | version <- NE.toList ((.supportedVersions) diagnostic),               Just definition <- [lookupLanguageDefinition version]             ]           publishedVersions =-            [version | (version, definition) <- supportedDefinitions, definitionMaturity definition == PublishedLanguage]+            [version | (version, definition) <- supportedDefinitions, (.maturity) definition == PublishedLanguage]           -- Released compatibility diagnostics are byte-stable. Publishing a           -- successor must not rewrite the predecessor version they recommend.           publishedCompatibilityVersions =             [ version             | (version, definition) <- supportedDefinitions,-              definitionMaturity definition == PublishedLanguage,-              definitionSupport definition == CompatibilityOnly+              (.maturity) definition == PublishedLanguage,+              (.support) definition == CompatibilityOnly             ]  -- | A parsed document with its source declaration preserved beside its graph. data ParsedSource = ParsedSource-  { parsedSourceLanguage :: !SourceLanguage,-    parsedSpec :: !Spec+  { sourceLanguage :: !SourceLanguage,+    spec :: !Spec   }   deriving stock (Eq, Show)

src/Keiro/Dsl/Manifest.hs view

@@ -89,7 +89,7 @@       ++ consumerBlocks   where     plan = consumerPlanForService service-    moduleNames = sort (map (moduleNameOf . modulePath) mods)+    moduleNames = sort (map (moduleNameOf . (.path)) mods)     otherModules = case facadeModule of       Nothing -> moduleNames       Just facade -> filter (/= facade) moduleNames@@ -97,16 +97,16 @@       Nothing -> []       Just facade -> ["", "exposed-modules:", "    " <> facade]     consumerBlocks-      | null (consumerMappings plan) = []+      | null ((.mappings) plan) = []       | otherwise =           [ "",             "consumer-packages:"           ]-            ++ map ("    " <>) (consumerPackages plan)+            ++ map ("    " <>) ((.packages) plan)             ++ [ "",                  "consumer-modules:"                ]-            ++ map ("    " <>) (consumerModules plan)+            ++ map ("    " <>) ((.modules) plan)  -- | The dotted module name recovered from a 'ScaffoldModule' path: drop the -- trailing @.hs@ and replace @/@ with @.@.@@ -120,7 +120,7 @@  manifestDependenciesForService :: CheckedService -> [Text] manifestDependenciesForService service =-  sort (nub ("base" : consumerPackages (consumerPlanForService service) <> concatMap (depsForNode service) (specNodes spec)))+  sort (nub ("base" : (.packages) (consumerPlanForService service) <> concatMap (depsForNode service) ((.nodes) spec)))   where     spec = checkedSpec service @@ -149,9 +149,9 @@     hasTypedContractId contract =       or         [ contractIdDomainContractFor (checkedLanguageContract service) prefix /= Nothing-        | event <- ctrEvents contract,-          field <- ceFields event,-          CTypeId prefix <- [cfType field]+        | event <- (.events) contract,+          field <- (.fields) event,+          CTypeId prefix <- [(.valueType) field]         ]  workqueueDependencies :: WorkqueueNode -> [Text]@@ -159,7 +159,7 @@   ["containers" | any (typeExprUses isMap) expressions]     <> ["time" | any (typeExprUses isTime) expressions]   where-    expressions = [expression | field <- wqPayload workqueue, TypedQueueExpression expression <- [wqfType field]]+    expressions = [expression | field <- (.payload) workqueue, TypedQueueExpression expression <- [(.valueType) field]]     isMap (TMap _) = True     isMap _ = False     isTime TTime = True@@ -178,9 +178,9 @@     <> ["containers" | any (typeExprUses isMap) expressions]     <> ["time" | any (typeExprUses isTime) expressions]   where-    expressions = case queryTypes readModel of+    expressions = case (.queryTypes) readModel of       Nothing -> []-      Just queryPair -> [input queryPair, result queryPair]+      Just queryPair -> [(.input) queryPair, (.result) queryPair]     isJson TJson = True     isJson _ = False     isMap TMap {} = True@@ -205,8 +205,8 @@         <> Set.fromList           [ "mmzk-typeid"           | AggregateNominal nominal <- resolvedTypes,-            IdRepresentation {} <- [resolvedNominalRepresentation nominal],-            ConsumerNominal {} <- [resolvedNominalOwnership nominal]+            IdRepresentation {} <- [(.representation) nominal],+            ConsumerNominal {} <- [(.ownership) nominal]           ]     )   where@@ -214,17 +214,17 @@     symbols = aggregateSymbolsFromGraphResult (checkedTypeGraph service) spec     resolvedTypes =       [ resolvedType-      | register <- aggRegs aggregate,-        Right resolvedType <- [resolveAggregateType symbols (regLoc register) RegisterUse (regType register)]+      | register <- (.regs) aggregate,+        Right resolvedType <- [resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register)]       ]         <> [ resolvedType-           | command <- aggCommands aggregate,-             field <- cmdFields command,+           | command <- (.commands) aggregate,+             field <- (.fields) command,              Right resolvedType <- [inferAggregateFieldType symbols aggregate CommandFieldUse field]            ]         <> [ resolvedType-           | event <- aggEvents aggregate,-             EventFields fields <- [evBody event],+           | event <- (.events) aggregate,+             EventFields fields <- [(.body) event],              field <- fields,              Right resolvedType <- [inferAggregateFieldType symbols aggregate EventFieldUse field]            ]

src/Keiro/Dsl/MappedCodecPlan.hs view

@@ -69,7 +69,7 @@           onOptional = id,           onList = id,           onMap = id,-          onRef = \key -> case Map.lookup key (tgDeclarations graph) of+          onRef = \key -> case Map.lookup key ((.declarations) graph) of             Just ResolvedStructural {} -> Set.singleton (StructuralAuthority key)             Just ResolvedOpaque {} -> Set.singleton (OpaqueAuthority key)             Nothing -> Set.empty@@ -91,13 +91,13 @@         onMap = \encode candidate -> "toJSON (Map.map (\\item -> " <> encode "item" <> ") (" <> candidate <> "))",         onRef = encodeReference       }-    (resolvedExpression plan)+    ((.resolvedExpression) plan)     value   where     primitive candidate = "toJSON (" <> candidate <> ")"-    encodeReference key candidate = case Map.lookup key (tgDeclarations graph) of+    encodeReference key candidate = case Map.lookup key ((.declarations) graph) of       Just (ResolvedStructural declaration _) ->-        "encode" <> sdName declaration <> suffix <> argument candidate+        "encode" <> (.name) declaration <> suffix <> argument candidate       Just ResolvedOpaque {} -> case boundary of         ConsumerValueBoundary -> "toJSON " <> candidate         StructuralShapeBoundary -> primitive candidate@@ -125,10 +125,10 @@         onMap = \decode -> "\\value -> (parseJSON value :: Parser (Map Text Value)) >>= traverse (" <> decode <> ")",         onRef = parseReference       }-    (resolvedExpression plan)+    ((.resolvedExpression) plan)   where-    parseReference key = case Map.lookup key (tgDeclarations graph) of-      Just (ResolvedStructural declaration _) -> "parse" <> sdName declaration <> suffix+    parseReference key = case Map.lookup key ((.declarations) graph) of+      Just (ResolvedStructural declaration _) -> "parse" <> (.name) declaration <> suffix       Just ResolvedOpaque {} -> "parseJSON"       Nothing -> "parseJSON"     suffix = case boundary of

src/Keiro/Dsl/MappedConsumer.hs view

@@ -22,84 +22,84 @@ import Keiro.Dsl.TypeGraph  data ConsumerPlan = ConsumerPlan-  { consumerPackages :: ![Text],-    consumerModules :: ![Text],-    consumerMappings :: ![MappingIdentity]+  { packages :: ![Text],+    modules :: ![Text],+    mappings :: ![MappingIdentity]   }   deriving stock (Eq, Show)  data MappingIdentity   = StructuralMapping-      { mappingSpecName :: !Text,-        mappingCanonicalType :: !Text,-        mappingPackage :: !Text,-        mappingModule :: !Text,-        mappingType :: !Text,-        mappingBindingSymbol :: !Text,-        mappingBindingVersion :: !Text+      { specName :: !Text,+        canonicalType :: !Text,+        package :: !Text,+        moduleName :: !Text,+        valueType :: !Text,+        bindingSymbol :: !Text,+        bindingVersion :: !Text       }   | OpaqueMapping-      { mappingSpecName :: !Text,-        mappingPackage :: !Text,-        mappingModule :: !Text,-        mappingType :: !Text,-        mappingCodecIdentity :: !Text,-        mappingCodecVersion :: !Text+      { specName :: !Text,+        package :: !Text,+        moduleName :: !Text,+        valueType :: !Text,+        codecIdentity :: !Text,+        codecVersion :: !Text       }   | NominalMapping-      { mappingSpecName :: !Text,-        mappingNominalCategory :: !Text,-        mappingNominalRepresentation :: !Text,-        mappingCanonicalType :: !Text,-        mappingPackage :: !Text,-        mappingModule :: !Text,-        mappingType :: !Text,-        mappingBindingSymbol :: !Text,-        mappingBindingVersion :: !Text,-        mappingFixtureSymbol :: !Text,-        mappingInitialSymbol :: !(Maybe Text)+      { specName :: !Text,+        nominalCategory :: !Text,+        nominalRepresentation :: !Text,+        canonicalType :: !Text,+        package :: !Text,+        moduleName :: !Text,+        valueType :: !Text,+        bindingSymbol :: !Text,+        bindingVersion :: !Text,+        fixtureSymbol :: !Text,+        initialSymbol :: !(Maybe Text)       }   deriving stock (Eq, Show)  instance ToJSON MappingIdentity where-  toJSON StructuralMapping {mappingSpecName, mappingCanonicalType, mappingPackage, mappingModule, mappingType, mappingBindingSymbol, mappingBindingVersion} =+  toJSON StructuralMapping {specName, canonicalType, package, moduleName, valueType, bindingSymbol, bindingVersion} =     object       [ "schema" .= (1 :: Int),         "mode" .= ("structural" :: Text),-        "specName" .= mappingSpecName,-        "canonicalType" .= mappingCanonicalType,-        "package" .= mappingPackage,-        "module" .= mappingModule,-        "type" .= mappingType,-        "bindingSymbol" .= mappingBindingSymbol,-        "bindingVersion" .= mappingBindingVersion+        "specName" .= specName,+        "canonicalType" .= canonicalType,+        "package" .= package,+        "module" .= moduleName,+        "type" .= valueType,+        "bindingSymbol" .= bindingSymbol,+        "bindingVersion" .= bindingVersion       ]-  toJSON OpaqueMapping {mappingSpecName, mappingPackage, mappingModule, mappingType, mappingCodecIdentity, mappingCodecVersion} =+  toJSON OpaqueMapping {specName, package, moduleName, valueType, codecIdentity, codecVersion} =     object       [ "schema" .= (1 :: Int),         "mode" .= ("opaque" :: Text),-        "specName" .= mappingSpecName,-        "package" .= mappingPackage,-        "module" .= mappingModule,-        "type" .= mappingType,-        "codecIdentity" .= mappingCodecIdentity,-        "codecVersion" .= mappingCodecVersion+        "specName" .= specName,+        "package" .= package,+        "module" .= moduleName,+        "type" .= valueType,+        "codecIdentity" .= codecIdentity,+        "codecVersion" .= codecVersion       ]-  toJSON NominalMapping {mappingSpecName, mappingNominalCategory, mappingNominalRepresentation, mappingCanonicalType, mappingPackage, mappingModule, mappingType, mappingBindingSymbol, mappingBindingVersion, mappingFixtureSymbol, mappingInitialSymbol} =+  toJSON NominalMapping {specName, nominalCategory = resolvedNominalCategory, nominalRepresentation, canonicalType, package, moduleName, valueType, bindingSymbol, bindingVersion, fixtureSymbol, initialSymbol} =     object       [ "schema" .= (1 :: Int),         "mode" .= ("nominal" :: Text),-        "specName" .= mappingSpecName,-        "category" .= mappingNominalCategory,-        "representation" .= mappingNominalRepresentation,-        "canonicalType" .= mappingCanonicalType,-        "package" .= mappingPackage,-        "module" .= mappingModule,-        "type" .= mappingType,-        "bindingSymbol" .= mappingBindingSymbol,-        "bindingVersion" .= mappingBindingVersion,-        "fixtureSymbol" .= mappingFixtureSymbol,-        "initialSymbol" .= mappingInitialSymbol+        "specName" .= specName,+        "category" .= resolvedNominalCategory,+        "representation" .= nominalRepresentation,+        "canonicalType" .= canonicalType,+        "package" .= package,+        "module" .= moduleName,+        "type" .= valueType,+        "bindingSymbol" .= bindingSymbol,+        "bindingVersion" .= bindingVersion,+        "fixtureSymbol" .= fixtureSymbol,+        "initialSymbol" .= initialSymbol       ]  instance FromJSON MappingIdentity where@@ -149,93 +149,93 @@ consumerPlanForService service = case (checkedTypeGraph service, resolveNominalTypes spec) of   (Right graph, Right nominalRegistry) ->     ConsumerPlan-      { consumerPackages = uniqueSorted ([hsPackage (mappedSource declaration) | declaration <- declarations] <> map nominalPackage nominalBindings),-        consumerModules = uniqueSorted (concatMap mappedModules declarations <> concatMap nominalModules nominalBindings),-        consumerMappings = sortMappings (map mappingIdentity declarations <> map nominalMappingIdentity nominalBindings)+      { packages = uniqueSorted ([(.package) (mappedSource declaration) | declaration <- declarations] <> map nominalPackage nominalBindings),+        modules = uniqueSorted (concatMap mappedModules declarations <> concatMap nominalModules nominalBindings),+        mappings = sortMappings (map mappingIdentity declarations <> map nominalMappingIdentity nominalBindings)       }     where-      declarations = Map.elems (tgDeclarations graph)+      declarations = Map.elems ((.declarations) graph)       nominalBindings =         [ (nominal, binding)         | nominal <- Map.elems (nominalTypes nominalRegistry),-          ConsumerNominal binding <- [resolvedNominalOwnership nominal]+          ConsumerNominal binding <- [(.ownership) nominal]         ]   _ -> ConsumerPlan [] [] []   where     spec = checkedSpec service  mappedSource :: ResolvedMappedDecl -> HaskellSource-mappedSource (ResolvedStructural declaration _) = sdHaskell declaration-mappedSource (ResolvedOpaque declaration) = odHaskell declaration+mappedSource (ResolvedStructural declaration _) = (.haskell) declaration+mappedSource (ResolvedOpaque declaration) = (.haskell) declaration  mappedModules :: ResolvedMappedDecl -> [Text] mappedModules (ResolvedStructural declaration _) =-  hsModule (sdHaskell declaration)-    : qualifiedModule (sdBinding declaration)-    : qualifiedModule (sdFixtures declaration)-    : maybe [] (pure . qualifiedModule) (sdInitial declaration)+  (.moduleName) ((.haskell) declaration)+    : qualifiedModule ((.binding) declaration)+    : qualifiedModule ((.fixtures) declaration)+    : maybe [] (pure . qualifiedModule) ((.initial) declaration) mappedModules (ResolvedOpaque declaration) =-  hsModule (odHaskell declaration)-    : qualifiedModule (odFixtures declaration)-    : maybe [] (pure . qualifiedModule) (odInitial declaration)+  (.moduleName) ((.haskell) declaration)+    : qualifiedModule ((.fixtures) declaration)+    : maybe [] (pure . qualifiedModule) ((.initial) declaration)  mappingIdentity :: ResolvedMappedDecl -> MappingIdentity mappingIdentity (ResolvedStructural declaration _) =   StructuralMapping-    { mappingSpecName = sdName declaration,-      mappingCanonicalType = unCanonicalTypeId (sdCanonical declaration),-      mappingPackage = hsPackage (sdHaskell declaration),-      mappingModule = hsModule (sdHaskell declaration),-      mappingType = hsType (sdHaskell declaration),-      mappingBindingSymbol = unQualifiedValueName (sdBinding declaration),-      mappingBindingVersion = unBindingVersion (sdBindingVersion declaration)+    { specName = (.name) declaration,+      canonicalType = unCanonicalTypeId ((.canonical) declaration),+      package = (.package) ((.haskell) declaration),+      moduleName = (.moduleName) ((.haskell) declaration),+      valueType = (.valueType) ((.haskell) declaration),+      bindingSymbol = unQualifiedValueName ((.binding) declaration),+      bindingVersion = unBindingVersion ((.bindingVersion) declaration)     } mappingIdentity (ResolvedOpaque declaration) =   OpaqueMapping-    { mappingSpecName = odName declaration,-      mappingPackage = hsPackage (odHaskell declaration),-      mappingModule = hsModule (odHaskell declaration),-      mappingType = hsType (odHaskell declaration),-      mappingCodecIdentity = unCodecIdentity (odCodecIdentity declaration),-      mappingCodecVersion = unCodecVersion (odCodecVersion declaration)+    { specName = (.name) declaration,+      package = (.package) ((.haskell) declaration),+      moduleName = (.moduleName) ((.haskell) declaration),+      valueType = (.valueType) ((.haskell) declaration),+      codecIdentity = unCodecIdentity ((.codecIdentity) declaration),+      codecVersion = unCodecVersion ((.codecVersion) declaration)     }  nominalMappingIdentity :: (ResolvedNominalType, ConsumerNominalBinding) -> MappingIdentity nominalMappingIdentity (nominal, binding) =   NominalMapping-    { mappingSpecName = resolvedNominalName nominal,-      mappingNominalCategory = nominalCategory nominal,-      mappingNominalRepresentation = nominalRepresentationIdentity nominal,-      mappingCanonicalType = unCanonicalTypeId (consumerNominalCanonical binding),-      mappingPackage = hsPackage source,-      mappingModule = hsModule source,-      mappingType = hsType source,-      mappingBindingSymbol = unQualifiedValueName (consumerNominalBinding binding),-      mappingBindingVersion = unBindingVersion (consumerNominalBindingVersion binding),-      mappingFixtureSymbol = unQualifiedValueName (consumerNominalFixtures binding),-      mappingInitialSymbol = unQualifiedValueName <$> consumerNominalInitial binding+    { specName = (.name) nominal,+      nominalCategory = nominalCategory nominal,+      nominalRepresentation = nominalRepresentationIdentity nominal,+      canonicalType = unCanonicalTypeId ((.canonical) binding),+      package = (.package) source,+      moduleName = (.moduleName) source,+      valueType = (.valueType) source,+      bindingSymbol = unQualifiedValueName ((.binding) binding),+      bindingVersion = unBindingVersion ((.bindingVersion) binding),+      fixtureSymbol = unQualifiedValueName ((.fixtures) binding),+      initialSymbol = unQualifiedValueName <$> (.initial) binding     }   where-    source = consumerNominalHaskell binding+    source = (.haskell) binding  nominalPackage :: (ResolvedNominalType, ConsumerNominalBinding) -> Text-nominalPackage (_, binding) = hsPackage (consumerNominalHaskell binding)+nominalPackage (_, binding) = (.package) ((.haskell) binding)  nominalModules :: (ResolvedNominalType, ConsumerNominalBinding) -> [Text] nominalModules (_, binding) =-  hsModule (consumerNominalHaskell binding)-    : qualifiedModule (consumerNominalBinding binding)-    : qualifiedModule (consumerNominalFixtures binding)-    : maybe [] (pure . qualifiedModule) (consumerNominalInitial binding)+  (.moduleName) ((.haskell) binding)+    : qualifiedModule ((.binding) binding)+    : qualifiedModule ((.fixtures) binding)+    : maybe [] (pure . qualifiedModule) ((.initial) binding)  nominalCategory :: ResolvedNominalType -> Text-nominalCategory nominal = case resolvedNominalRepresentation nominal of+nominalCategory nominal = case (.representation) nominal of   IdRepresentation {} -> "id"   EnumRepresentation {} -> "enum"   ScalarRepresentation {} -> "scalar"  nominalRepresentationIdentity :: ResolvedNominalType -> Text-nominalRepresentationIdentity nominal = case resolvedNominalRepresentation nominal of+nominalRepresentationIdentity nominal = case (.representation) nominal of   IdRepresentation prefix -> "KindID:" <> prefix   EnumRepresentation constructors ->     "enum:" <> T.intercalate "," [constructor <> "=" <> wire | (constructor, wire) <- NE.toList constructors]@@ -255,9 +255,9 @@     sortOnName [] = []     sortOnName mappings =       [ mapping-      | name <- sort (map mappingSpecName mappings),+      | name <- sort (map (.specName) mappings),         mapping <- mappings,-        mappingSpecName mapping == name+        (.specName) mapping == name       ]  uniqueSorted :: [Text] -> [Text]

src/Keiro/Dsl/MappedDiff.hs view

@@ -25,12 +25,12 @@ import Keiro.Dsl.Validate (DiagnosticCode (..))  data MappedFinding = MappedFinding-  { mfDeclaration :: !Name,-    mfLeaf :: !Text,-    mfCode :: !DiagnosticCode,-    mfDetail :: !Text,-    mfUsePaths :: ![UsePath],-    mfOldUnknownFields :: !(Maybe UnknownFields)+  { declaration :: !Name,+    leaf :: !Text,+    code :: !DiagnosticCode,+    detail :: !Text,+    usePaths :: ![UsePath],+    oldUnknownFields :: !(Maybe UnknownFields)   }   deriving stock (Eq, Show) @@ -44,8 +44,8 @@       ++ map (addedDeclaration newGraph) added       ++ map (removedDeclaration oldGraph) removed     where-      oldDeclarations = tgDeclarations oldGraph-      newDeclarations = tgDeclarations newGraph+      oldDeclarations = (.declarations) oldGraph+      newDeclarations = (.declarations) newGraph       matched =         [ (oldDeclaration, newDeclaration)         | (key, newDeclaration) <- Map.toList newDeclarations,@@ -152,7 +152,7 @@       "haskell"       MappedHaskellSourceChanged       "consumer package, module, or type changed without changing declared wire identity; recompile every affected consumer"-  | sdHaskell oldDeclaration /= sdHaskell newDeclaration+  | (.haskell) oldDeclaration /= (.haskell) newDeclaration   ]     ++ [ finding            paths@@ -160,8 +160,8 @@            "binding"            MappedBindingChanged            "binding symbol or binding-version changed; diff cannot inspect binding behavior, so run the two-law, codec, and historical-fixture conformance suite"-       | (sdBinding oldDeclaration, sdBindingVersion oldDeclaration)-           /= (sdBinding newDeclaration, sdBindingVersion newDeclaration)+       | ((.binding) oldDeclaration, (.bindingVersion) oldDeclaration)+           /= ((.binding) newDeclaration, (.bindingVersion) newDeclaration)        ]     ++ [ finding            paths@@ -169,7 +169,7 @@            "fixtures"            MappedFixturesChanged            "fixture evidence symbol changed; runtime wire policy is unchanged, but the complete conformance suite must run"-       | sdFixtures oldDeclaration /= sdFixtures newDeclaration+       | (.fixtures) oldDeclaration /= (.fixtures) newDeclaration        ]     ++ [ finding            paths@@ -177,7 +177,7 @@            "initial"            MappedInitialChanged            "mapped initial symbol changed; new streams and snapshot fingerprints may change while historical event decoding does not"-       | sdInitial oldDeclaration /= sdInitial newDeclaration+       | (.initial) oldDeclaration /= (.initial) newDeclaration        ]     ++ [ finding            paths@@ -185,10 +185,10 @@            "canonical-type"            MappedCanonicalTypeChanged            "canonical type identity changed; rebuild generated projections and invalidate mapped snapshots while declared event bytes remain unchanged"-       | sdCanonical oldDeclaration /= sdCanonical newDeclaration+       | (.canonical) oldDeclaration /= (.canonical) newDeclaration        ]   where-    name = sdName newDeclaration+    name = (.name) newDeclaration  opaqueMetadataDiff :: [UsePath] -> OpaqueDecl -> OpaqueDecl -> [MappedFinding] opaqueMetadataDiff paths oldDeclaration newDeclaration =@@ -198,7 +198,7 @@       "haskell"       MappedHaskellSourceChanged       "consumer package, module, or type changed without changing the opaque codec claim; recompile every affected consumer"-  | odHaskell oldDeclaration /= odHaskell newDeclaration+  | (.haskell) oldDeclaration /= (.haskell) newDeclaration   ]     ++ [ finding            paths@@ -206,8 +206,8 @@            "codec"            MappedOpaqueCodecChanged            "opaque codec identity or version changed; Keiro cannot inspect the codec and historical payload compatibility is unproven"-       | (odCodecIdentity oldDeclaration, odCodecVersion oldDeclaration)-           /= (odCodecIdentity newDeclaration, odCodecVersion newDeclaration)+       | ((.codecIdentity) oldDeclaration, (.codecVersion) oldDeclaration)+           /= ((.codecIdentity) newDeclaration, (.codecVersion) newDeclaration)        ]     ++ [ finding            paths@@ -215,7 +215,7 @@            "fixtures"            MappedFixturesChanged            "fixture evidence symbol changed; runtime codec identity is unchanged, but the complete conformance suite must run"-       | odFixtures oldDeclaration /= odFixtures newDeclaration+       | (.fixtures) oldDeclaration /= (.fixtures) newDeclaration        ]     ++ [ finding            paths@@ -223,10 +223,10 @@            "initial"            MappedInitialChanged            "mapped initial symbol changed; new streams and snapshot fingerprints may change while historical event decoding does not"-       | odInitial oldDeclaration /= odInitial newDeclaration+       | (.initial) oldDeclaration /= (.initial) newDeclaration        ]   where-    name = odName newDeclaration+    name = (.name) newDeclaration  diffShape :: [UsePath] -> Name -> ShapeView -> ShapeView -> [MappedFinding] diffShape paths declaration oldShape newShape = case (oldShape, newShape) of@@ -278,7 +278,7 @@     addedFinding field =       (findingWithUnknown paths declaration (fieldLeaf field) code detail (Just oldUnknown))       where-        hasDefault = isJustValue (rwfOnMissing field)+        hasDefault = isJustValue ((.onMissing) field)         code           | hasDefault = MappedFieldAddedWithDefault           | otherwise = MappedFieldAddedNoDefault@@ -303,21 +303,21 @@     exact =       [ (oldField, newField)       | newField <- newFields,-        oldField <- maybeToList (find ((== rwfHaskell newField) . rwfHaskell) oldFields)+        oldField <- maybeToList (find ((== (.haskell) newField) . (.haskell)) oldFields)       ]-    matchedOld = map (rwfHaskell . fst) exact-    matchedNew = map (rwfHaskell . snd) exact-    unmatchedOld = [field | field <- oldFields, rwfHaskell field `notElem` matchedOld]-    unmatchedNew = [field | field <- newFields, rwfHaskell field `notElem` matchedNew]+    matchedOld = map ((.haskell) . fst) exact+    matchedNew = map ((.haskell) . snd) exact+    unmatchedOld = [field | field <- oldFields, (.haskell) field `notElem` matchedOld]+    unmatchedNew = [field | field <- newFields, (.haskell) field `notElem` matchedNew]     fallback =       [ (oldField, newField)       | newField <- unmatchedNew,-        oldField <- maybeToList (find ((== rwfKey newField) . rwfKey) unmatchedOld)+        oldField <- maybeToList (find ((== (.key) newField) . (.key)) unmatchedOld)       ]-    fallbackOld = map (rwfHaskell . fst) fallback-    fallbackNew = map (rwfHaskell . snd) fallback-    removed = [field | field <- unmatchedOld, rwfHaskell field `notElem` fallbackOld]-    added = [field | field <- unmatchedNew, rwfHaskell field `notElem` fallbackNew]+    fallbackOld = map ((.haskell) . fst) fallback+    fallbackNew = map ((.haskell) . snd) fallback+    removed = [field | field <- unmatchedOld, (.haskell) field `notElem` fallbackOld]+    added = [field | field <- unmatchedNew, (.haskell) field `notElem` fallbackNew]  diffField :: [UsePath] -> Name -> ResolvedWireField -> ResolvedWireField -> [MappedFinding] diffField paths declaration oldField newField =@@ -327,23 +327,23 @@       leaf       GeneratedHaskellNameChanged       ( "generated record selector changed '"-          <> normalizedGeneratedLower (rwfHaskell oldField)+          <> normalizedGeneratedLower ((.haskell) oldField)           <> "' -> '"-          <> normalizedGeneratedLower (rwfHaskell newField)+          <> normalizedGeneratedLower ((.haskell) newField)           <> "' while wire key '"-          <> rwfKey newField+          <> (.key) newField           <> "' remains unchanged; re-scaffold and recompile consumers"       )-  | rwfKey oldField == rwfKey newField,-    normalizedGeneratedLower (rwfHaskell oldField) /= normalizedGeneratedLower (rwfHaskell newField)+  | (.key) oldField == (.key) newField,+    normalizedGeneratedLower ((.haskell) oldField) /= normalizedGeneratedLower ((.haskell) newField)   ]     ++ [ finding            paths            declaration            leaf            MappedWireKeyChanged-           ("wire key changed '" <> rwfKey oldField <> "' -> '" <> rwfKey newField <> "'; version and upcast every affected private event root")-       | rwfKey oldField /= rwfKey newField+           ("wire key changed '" <> (.key) oldField <> "' -> '" <> (.key) newField <> "'; version and upcast every affected private event root")+       | (.key) oldField /= (.key) newField        ]     ++ [ finding            paths@@ -351,13 +351,13 @@            leaf            MappedPresenceChanged            "field presence changed between required and optional; historical decode policy changed"-       | rwfPresence oldField /= rwfPresence newField+       | (.presence) oldField /= (.presence) newField        ]     ++ defaultChanges-    ++ diffExpr paths declaration (leaf <> ".type") (rwfType oldField) (rwfType newField)+    ++ diffExpr paths declaration (leaf <> ".type") ((.valueType) oldField) ((.valueType) newField)   where     leaf = fieldLeaf newField-    defaultChanges = case (rwfOnMissing oldField, rwfOnMissing newField) of+    defaultChanges = case ((.onMissing) oldField, (.onMissing) newField) of       (Just _, Nothing) ->         [ finding             paths@@ -380,15 +380,15 @@ normalizedGeneratedLower :: Text -> Text normalizedGeneratedLower logicalName =   case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-    Right derived -> HaskellName.renderLowerCamelName (HaskellName.lowerCamel derived)+    Right derived -> HaskellName.renderLowerCamelName ((.lowerCamel) derived)     Left _ -> logicalName   where     site =       HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedFieldSite,-          HaskellName.siteLogicalName = logicalName,-          HaskellName.siteOwner = "mapped-diff",-          HaskellName.siteLine = 0+        { HaskellName.kind = HaskellName.GeneratedFieldSite,+          HaskellName.logicalName = logicalName,+          HaskellName.owner = "mapped-diff",+          HaskellName.line = 0         }  diffExpr :: [UsePath] -> Name -> Text -> ResolvedTypeExpr -> ResolvedTypeExpr -> [MappedFinding]@@ -439,10 +439,10 @@       declaration       (enumLeaf newEntry)       MappedEnumSpellingChanged-      ("enum wire spelling changed '" <> weTag oldEntry <> "' -> '" <> weTag newEntry <> "'")+      ("enum wire spelling changed '" <> (.tag) oldEntry <> "' -> '" <> (.tag) newEntry <> "'")   | newEntry <- newEntries,-    oldEntry <- maybeToList (find ((== weCtor newEntry) . weCtor) oldEntries),-    weTag oldEntry /= weTag newEntry+    oldEntry <- maybeToList (find ((== (.ctor) newEntry) . (.ctor)) oldEntries),+    (.tag) oldEntry /= (.tag) newEntry   ]     ++ [ finding            paths@@ -451,7 +451,7 @@            MappedEnumValueAdded            "enum value added; existing history remains readable, but deploy readers before writers emit the new spelling; a future public surface exposing this closed enum would classify the addition as consumer-breaking"        | entry <- newEntries,-         isNothing (find ((== weCtor entry) . weCtor) oldEntries)+         isNothing (find ((== (.ctor) entry) . (.ctor)) oldEntries)        ]     ++ [ finding            paths@@ -460,7 +460,7 @@            MappedEnumValueRemoved            "enum value removed; historical payloads carrying its wire spelling no longer decode"        | entry <- oldEntries,-         isNothing (find ((== weCtor entry) . weCtor) newEntries)+         isNothing (find ((== (.ctor) entry) . (.ctor)) newEntries)        ]  diffUnion :: [UsePath] -> Name -> [ResolvedWireArm] -> [ResolvedWireArm] -> [MappedFinding]@@ -476,10 +476,10 @@           declaration           (armLeaf newArm)           MappedArmTagChanged-          ("union arm tag changed '" <> rwaTag oldArm <> "' -> '" <> rwaTag newArm <> "'")-      | rwaTag oldArm /= rwaTag newArm+          ("union arm tag changed '" <> (.tag) oldArm <> "' -> '" <> (.tag) newArm <> "'")+      | (.tag) oldArm /= (.tag) newArm       ]-        ++ case (rwaPayload oldArm, rwaPayload newArm) of+        ++ case ((.payload) oldArm, (.payload) newArm) of           (Nothing, Nothing) -> []           (Just oldPayload, Just newPayload) -> diffExpr paths declaration (armLeaf newArm <> ".payload") oldPayload newPayload           _ -> [finding paths declaration (armLeaf newArm) MappedFieldTypeChanged "union arm payload presence changed; historical tagged objects no longer share one wire shape"]@@ -492,21 +492,21 @@     exact =       [ (oldArm, newArm)       | newArm <- newArms,-        oldArm <- maybeToList (find ((== rwaCtor newArm) . rwaCtor) oldArms)+        oldArm <- maybeToList (find ((== (.ctor) newArm) . (.ctor)) oldArms)       ]-    matchedOld = map (rwaCtor . fst) exact-    matchedNew = map (rwaCtor . snd) exact-    unmatchedOld = [arm | arm <- oldArms, rwaCtor arm `notElem` matchedOld]-    unmatchedNew = [arm | arm <- newArms, rwaCtor arm `notElem` matchedNew]+    matchedOld = map ((.ctor) . fst) exact+    matchedNew = map ((.ctor) . snd) exact+    unmatchedOld = [arm | arm <- oldArms, (.ctor) arm `notElem` matchedOld]+    unmatchedNew = [arm | arm <- newArms, (.ctor) arm `notElem` matchedNew]     fallback =       [ (oldArm, newArm)       | newArm <- unmatchedNew,-        oldArm <- maybeToList (find ((== rwaTag newArm) . rwaTag) unmatchedOld)+        oldArm <- maybeToList (find ((== (.tag) newArm) . (.tag)) unmatchedOld)       ]-    fallbackOld = map (rwaCtor . fst) fallback-    fallbackNew = map (rwaCtor . snd) fallback-    removed = [arm | arm <- unmatchedOld, rwaCtor arm `notElem` fallbackOld]-    added = [arm | arm <- unmatchedNew, rwaCtor arm `notElem` fallbackNew]+    fallbackOld = map ((.ctor) . fst) fallback+    fallbackNew = map ((.ctor) . snd) fallback+    removed = [arm | arm <- unmatchedOld, (.ctor) arm `notElem` fallbackOld]+    added = [arm | arm <- unmatchedNew, (.ctor) arm `notElem` fallbackNew]  addedDeclaration :: TypeGraph -> (MappedKey, ResolvedMappedDecl) -> MappedFinding addedDeclaration _ (key, _) =@@ -536,18 +536,18 @@ resolvedName =   foldMappedDecl     MappedDeclAlgebra-      { onStructuralDecl = \declaration _ -> sdName declaration,-        onOpaqueDecl = odName+      { onStructuralDecl = \declaration _ -> (.name) declaration,+        onOpaqueDecl = (.name)       }  fieldLeaf :: ResolvedWireField -> Text-fieldLeaf field = ".field " <> rwfHaskell field <> "[\"" <> rwfKey field <> "\"]"+fieldLeaf field = ".field " <> (.haskell) field <> "[\"" <> (.key) field <> "\"]"  armLeaf :: ResolvedWireArm -> Text-armLeaf arm = ".arm " <> rwaCtor arm <> "[\"" <> rwaTag arm <> "\"]"+armLeaf arm = ".arm " <> (.ctor) arm <> "[\"" <> (.tag) arm <> "\"]"  enumLeaf :: WireEnum -> Text-enumLeaf entry = ".enum " <> weCtor entry <> "[\"" <> weTag entry <> "\"]"+enumLeaf entry = ".enum " <> (.ctor) entry <> "[\"" <> (.tag) entry <> "\"]"  finding :: [UsePath] -> Name -> Text -> DiagnosticCode -> Text -> MappedFinding finding paths declaration leaf code detail =@@ -556,12 +556,12 @@ findingWithUnknown :: [UsePath] -> Name -> Text -> DiagnosticCode -> Text -> Maybe UnknownFields -> MappedFinding findingWithUnknown paths declaration leaf code detail unknownFields =   MappedFinding-    { mfDeclaration = declaration,-      mfLeaf = leaf,-      mfCode = code,-      mfDetail = detail,-      mfUsePaths = paths,-      mfOldUnknownFields = unknownFields+    { declaration = declaration,+      leaf = leaf,+      code = code,+      detail = detail,+      usePaths = paths,+      oldUnknownFields = unknownFields     }  isJustValue :: Maybe a -> Bool

src/Keiro/Dsl/NominalType.hs view

@@ -41,7 +41,7 @@ import Keiro.Dsl.HaskellName (haskellKeywords) import Keiro.Dsl.IdDomain (enforcedIdDomainVersion) import Keiro.Dsl.LanguageVersion (RuntimeCapability (..), runtimeProfileHasCapability)-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedSpec, effectiveRuntimeProfile)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec) import Keiro.Dsl.TypeGraph  data NominalScalarRepresentation@@ -78,19 +78,19 @@   deriving stock (Eq, Ord, Show, Generic)  data CheckedNominalEquality = CheckedNominalEquality-  { equalityKeyRepresentation :: !NominalEqualityKey,-    equalityDomain :: !NominalEqualityDomain,-    equalityContractVersion :: !Text+  { keyRepresentation :: !NominalEqualityKey,+    domain :: !NominalEqualityDomain,+    contractVersion :: !Text   }   deriving stock (Eq, Ord, Show, Generic)  data ConsumerNominalBinding = ConsumerNominalBinding-  { consumerNominalHaskell :: !HaskellSource,-    consumerNominalBinding :: !QualifiedValueName,-    consumerNominalBindingVersion :: !BindingVersion,-    consumerNominalCanonical :: !CanonicalTypeId,-    consumerNominalFixtures :: !QualifiedValueName,-    consumerNominalInitial :: !(Maybe QualifiedValueName)+  { haskell :: !HaskellSource,+    binding :: !QualifiedValueName,+    bindingVersion :: !BindingVersion,+    canonical :: !CanonicalTypeId,+    fixtures :: !QualifiedValueName,+    initial :: !(Maybe QualifiedValueName)   }   deriving stock (Eq, Ord, Show, Generic) @@ -100,40 +100,41 @@   deriving stock (Eq, Ord, Show, Generic)  data ResolvedNominalType = ResolvedNominalType-  { resolvedNominalName :: !Name,-    resolvedNominalRepresentation :: !NominalRepresentation,-    resolvedNominalOwnership :: !NominalOwnership,-    resolvedNominalLoc :: !Loc+  { name :: !Name,+    representation :: !NominalRepresentation,+    ownership :: !NominalOwnership,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  instance Ord ResolvedNominalType where   compare left right =     compare-      (resolvedNominalName left, resolvedNominalRepresentation left, resolvedNominalOwnership left)-      (resolvedNominalName right, resolvedNominalRepresentation right, resolvedNominalOwnership right)+      ((.name) left, (.representation) left, (.ownership) left)+      ((.name) right, (.representation) right, (.ownership) right) -newtype NominalTypeRegistry = NominalTypeRegistry-  { nominalTypes :: Map Name ResolvedNominalType-  }+newtype NominalTypeRegistry = NominalTypeRegistry (Map Name ResolvedNominalType)   deriving stock (Eq, Show, Generic) +nominalTypes :: NominalTypeRegistry -> Map Name ResolvedNominalType+nominalTypes (NominalTypeRegistry values) = values+ lookupNominalType :: Name -> NominalTypeRegistry -> Maybe ResolvedNominalType lookupNominalType name = Map.lookup name . nominalTypes  nominalEqualityContractForService :: EffectiveLanguageContract -> ResolvedNominalType -> Maybe CheckedNominalEquality-nominalEqualityContractForService languageContract nominal = case resolvedNominalRepresentation nominal of+nominalEqualityContractForService languageContract nominal = case (.representation) nominal of   IdRepresentation prefix ->     Just       CheckedNominalEquality-        { equalityKeyRepresentation = NominalTextEqualityKey,-          equalityDomain =+        { keyRepresentation = NominalTextEqualityKey,+          domain =             if enforcesNominalEqualityV2               then EnforcedTypeIdV7TextDomain prefix enforcedIdDomainVersion-              else case resolvedNominalOwnership nominal of+              else case (.ownership) nominal of                 GeneratedNominal -> LegacyUnrestrictedTextDomain                 ConsumerNominal {} -> TypeIdTextDomain prefix,-          equalityContractVersion =+          contractVersion =             if enforcesNominalEqualityV2               then "keiro-dsl/nominal-equality/2"               else nominalEqualityContractVersion@@ -141,14 +142,14 @@   EnumRepresentation constructors ->     Just       CheckedNominalEquality-        { equalityKeyRepresentation = NominalTextEqualityKey,-          equalityDomain = FiniteTextDomain (snd <$> constructors),-          equalityContractVersion = nominalEqualityContractVersion+        { keyRepresentation = NominalTextEqualityKey,+          domain = FiniteTextDomain (snd <$> constructors),+          contractVersion = nominalEqualityContractVersion         }   ScalarRepresentation {} -> Nothing   where     enforcesNominalEqualityV2 =-      runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) NominalEqualityV2+      runtimeProfileHasCapability ((.runtimeProfile) languageContract) NominalEqualityV2  -- | Stable, checked identity used by generated projection tags, fingerprints, -- scaffold history, and explain output. It includes the existing binding@@ -158,11 +159,11 @@   equality <- nominalEqualityContractForService languageContract nominal   pure . T.intercalate "|" $     [ "nominal-equality",-      "name=" <> resolvedNominalName nominal,-      "contract=" <> equalityContractVersion equality,-      "key=" <> renderEqualityKey (equalityKeyRepresentation equality),-      "domain=" <> renderEqualityDomain (equalityDomain equality),-      renderOwnership (resolvedNominalOwnership nominal)+      "name=" <> (.name) nominal,+      "contract=" <> (.contractVersion) equality,+      "key=" <> renderEqualityKey ((.keyRepresentation) equality),+      "domain=" <> renderEqualityDomain ((.domain) equality),+      renderOwnership ((.ownership) nominal)     ]   where     renderEqualityKey NominalTextEqualityKey = "Text"@@ -176,9 +177,9 @@       T.intercalate         ";"         [ "owner=consumer",-          "canonical=" <> unCanonicalTypeId (consumerNominalCanonical binding),-          "binding=" <> unQualifiedValueName (consumerNominalBinding binding),-          "binding-version=" <> unBindingVersion (consumerNominalBindingVersion binding)+          "canonical=" <> unCanonicalTypeId ((.canonical) binding),+          "binding=" <> unQualifiedValueName ((.binding) binding),+          "binding-version=" <> unBindingVersion ((.bindingVersion) binding)         ]  nominalEqualityIdentitiesForService :: CheckedService -> [Text]@@ -211,45 +212,45 @@ resolveNominalTypes spec = do   resolved <- rejectErrors declarationErrors resolvedDeclarations   rejectMany collisionErrors-  let registry = NominalTypeRegistry (Map.fromList [(resolvedNominalName value, value) | value <- resolved])+  let registry = NominalTypeRegistry (Map.fromList [((.name) value, value) | value <- resolved])   rejectMany (registerInitialErrors registry)   pure registry   where     declarationResults =-      map resolveId (specIds spec)-        <> map resolveEnum (specEnums spec)-        <> map resolveScalar (specNominalScalars spec)+      map resolveId ((.ids) spec)+        <> map resolveEnum ((.enums) spec)+        <> map resolveScalar ((.nominalScalars) spec)     declarationErrors = concatMap fst declarationResults     resolvedDeclarations = [value | (_, Just value) <- declarationResults]      resolveId declaration =-      let name = idName declaration-          loc = idLoc declaration+      let name = (.name) declaration+          loc = (.loc) declaration           prefixErrors =-            case idBinding declaration >>= const (TypeID.checkPrefix (idPrefix declaration)) of+            case (.binding) declaration >>= const (TypeID.checkPrefix ((.prefix) declaration)) of               Nothing -> []-              Just err -> [NominalInvalidIdPrefix name loc (idPrefix declaration) (T.pack (show err))]-          (bindingErrors, ownership) = resolveOwnership name loc (idBinding declaration)+              Just err -> [NominalInvalidIdPrefix name loc ((.prefix) declaration) (T.pack (show err))]+          (bindingErrors, ownership) = resolveOwnership name loc ((.binding) declaration)           errors = prefixErrors <> bindingErrors-          value = ResolvedNominalType name (IdRepresentation (idPrefix declaration)) <$> ownership <*> pure loc+          value = ResolvedNominalType name (IdRepresentation ((.prefix) declaration)) <$> ownership <*> pure loc        in (errors, value <* guardNoErrors errors)      resolveEnum declaration =-      let name = enumName declaration-          loc = enumLoc declaration-          representation = NE.nonEmpty (enumCtors declaration)+      let name = (.name) declaration+          loc = (.loc) declaration+          representation = NE.nonEmpty ((.ctors) declaration)           representationErrors = [NominalEmptyEnum name loc | representation == Nothing]-          (bindingErrors, ownership) = resolveOwnership name loc (enumBinding declaration)+          (bindingErrors, ownership) = resolveOwnership name loc ((.binding) declaration)           errors = representationErrors <> bindingErrors           value = ResolvedNominalType name <$> (EnumRepresentation <$> representation) <*> ownership <*> pure loc        in (errors, value <* guardNoErrors errors)      resolveScalar declaration =-      let name = nominalScalarName declaration-          loc = nominalScalarLoc declaration-          representation = scalarRepresentation (nominalScalarRepresentation declaration)-          representationErrors = [NominalUnsupportedScalar name loc (nominalScalarRepresentation declaration) | representation == Nothing]-          (bindingErrors, ownership) = resolveRequiredOwnership name loc (nominalScalarBinding declaration)+      let name = (.name) declaration+          loc = (.loc) declaration+          representation = scalarRepresentation ((.representation) declaration)+          representationErrors = [NominalUnsupportedScalar name loc ((.representation) declaration) | representation == Nothing]+          (bindingErrors, ownership) = resolveRequiredOwnership name loc ((.binding) declaration)           errors = representationErrors <> bindingErrors           value = ResolvedNominalType name <$> (ScalarRepresentation <$> representation) <*> ownership <*> pure loc        in (errors, value <* guardNoErrors errors)@@ -263,21 +264,21 @@       ]     originsByName = Map.fromListWith (<>) [(name, [(category, loc)]) | (name, category, loc) <- origins]     origins =-      [(idName value, "id", idLoc value) | value <- specIds spec]-        <> [(enumName value, "enum", enumLoc value) | value <- specEnums spec]-        <> [(nominalScalarName value, "nominal scalar", nominalScalarLoc value) | value <- specNominalScalars spec]-        <> [(mappedName value, "mapped", mappedLoc value) | value <- specMapped spec]-        <> [(ruleName value, "rule", ruleLoc value) | value <- specRules spec]-        <> [(name, kind <> " node", loc) | node <- specNodes spec, let (kind, name, loc) = nodeIdentityLocal node]+      [((.name) value, "id", (.loc) value) | value <- (.ids) spec]+        <> [((.name) value, "enum", (.loc) value) | value <- (.enums) spec]+        <> [((.name) value, "nominal scalar", (.loc) value) | value <- (.nominalScalars) spec]+        <> [(mappedName value, "mapped", mappedLoc value) | value <- (.mapped) spec]+        <> [((.name) value, "rule", (.loc) value) | value <- (.rules) spec]+        <> [(name, kind <> " node", loc) | node <- (.nodes) spec, let (kind, name, loc) = nodeIdentityLocal node]      registerInitialErrors registry =-      [ NominalMissingRegisterInitial typeName (regLoc register) (regName register)-      | aggregate <- [value | NAggregate value <- specNodes spec],-        register <- aggRegs aggregate,-        TRef typeName <- [regType register],+      [ NominalMissingRegisterInitial typeName ((.loc) register) ((.name) register)+      | aggregate <- [value | NAggregate value <- (.nodes) spec],+        register <- (.regs) aggregate,+        TRef typeName <- [(.valueType) register],         Just resolved <- [lookupNominalType typeName registry],-        ConsumerNominal binding <- [resolvedNominalOwnership resolved],-        consumerNominalInitial binding == Nothing+        ConsumerNominal binding <- [(.ownership) resolved],+        (.initial) binding == Nothing       ]  resolveOwnership :: Name -> Loc -> Maybe NominalBindingDecl -> ([NominalTypeError], Maybe NominalOwnership)@@ -291,22 +292,22 @@     requiredErrors =       [NominalMissingIngredient name loc label | (label, missing) <- missingFacts, missing]     missingFacts =-      [ ("haskell", nominalHaskell binding == Nothing),-        ("binding", nominalBinding binding == Nothing),-        ("binding-version", nominalBindingVersion binding == Nothing),-        ("canonical-type", nominalCanonicalType binding == Nothing),-        ("fixtures", nominalFixtures binding == Nothing)+      [ ("haskell", (.haskell) binding == Nothing),+        ("binding", (.binding) binding == Nothing),+        ("binding-version", (.bindingVersion) binding == Nothing),+        ("canonical-type", (.canonicalType) binding == Nothing),+        ("fixtures", (.fixtures) binding == Nothing)       ]-    haskellErrors = maybe [] (validateHaskellSource name loc) (nominalHaskell binding)-    (bindingErrors, checkedBindingName) = validateQualified name loc "binding" (nominalBinding binding)-    (fixtureErrors, checkedFixtures) = validateQualified name loc "fixtures" (nominalFixtures binding)-    (initialErrors, checkedInitial) = validateOptionalQualified name loc "initial" (nominalInitial binding)-    (bindingVersionErrors, checkedBindingVersion) = validateBindingVersion name loc (nominalBindingVersion binding)-    (canonicalErrors, checkedCanonical) = validateCanonical name loc (nominalCanonicalType binding)+    haskellErrors = maybe [] (validateHaskellSource name loc) ((.haskell) binding)+    (bindingErrors, checkedBindingName) = validateQualified name loc "binding" ((.binding) binding)+    (fixtureErrors, checkedFixtures) = validateQualified name loc "fixtures" ((.fixtures) binding)+    (initialErrors, checkedInitial) = validateOptionalQualified name loc "initial" ((.initial) binding)+    (bindingVersionErrors, checkedBindingVersion) = validateBindingVersion name loc ((.bindingVersion) binding)+    (canonicalErrors, checkedCanonical) = validateCanonical name loc ((.canonicalType) binding)     errors = requiredErrors <> haskellErrors <> bindingErrors <> fixtureErrors <> initialErrors <> bindingVersionErrors <> canonicalErrors     checkedBinding =       ConsumerNominalBinding-        <$> nominalHaskell binding+        <$> (.haskell) binding         <*> checkedBindingName         <*> checkedBindingVersion         <*> checkedCanonical@@ -315,9 +316,9 @@  validateHaskellSource :: Name -> Loc -> HaskellSource -> [NominalTypeError] validateHaskellSource name loc source =-  [NominalInvalidHaskellSource name loc "package" | not (cabalPackageName (hsPackage source))]-    <> [NominalInvalidHaskellSource name loc "module" | not (moduleNameSafe (hsModule source))]-    <> [NominalInvalidHaskellSource name loc "type" | not (constructorSafe (hsType source))]+  [NominalInvalidHaskellSource name loc "package" | not (cabalPackageName ((.package) source))]+    <> [NominalInvalidHaskellSource name loc "module" | not (moduleNameSafe ((.moduleName) source))]+    <> [NominalInvalidHaskellSource name loc "type" | not (constructorSafe ((.valueType) source))]  validateQualified :: Name -> Loc -> Text -> Maybe Text -> ([NominalTypeError], Maybe QualifiedValueName) validateQualified _ _ _ Nothing = ([], Nothing)@@ -373,23 +374,23 @@  nodeIdentityLocal :: Node -> (Text, Name, Loc) nodeIdentityLocal = \case-  NAggregate value -> ("aggregate", aggName value, aggLoc value)-  NProcess value -> ("process", procId value, procLoc value)-  NRouter value -> ("router", rtId value, rtLoc value)-  NContract value -> ("contract", ctrName value, ctrLoc value)-  NIntake value -> ("intake", inkName value, inkLoc value)-  NEmit value -> ("emit", emName value, emLoc value)-  NPublisher value -> ("publisher", pubName value, pubLoc value)-  NWorkqueue value -> ("workqueue", wqName value, wqLoc value)-  NPgmqDispatch value -> ("dispatch", pdName value, pdLoc value)-  NReadModel value -> ("readmodel", rmName value, rmLoc value)-  NProjectionTarget value -> ("target", ptName value, ptLoc value)-  NRebuildGroup value -> ("rebuild-group", rgName value, rgLoc value)-  NProjectionRevision value -> ("projection-revision", prvName value, prvLoc value)-  NExternalRead value -> ("external-read", externalReadNodeIdentity value, erLoc value)-  NProjectionOwner value -> ("projection-owner", poName value, poLoc value)-  NWorkflow value -> ("workflow", wfId value, workflowNodeLoc value)-  NOperation value -> ("operation", opName value, opLoc value)+  NAggregate value -> ("aggregate", (.name) value, (.loc) value)+  NProcess value -> ("process", (.id) value, (.loc) value)+  NRouter value -> ("router", (.id) value, (.loc) value)+  NContract value -> ("contract", (.name) value, (.loc) value)+  NIntake value -> ("intake", (.name) value, (.loc) value)+  NEmit value -> ("emit", (.name) value, (.loc) value)+  NPublisher value -> ("publisher", (.name) value, (.loc) value)+  NWorkqueue value -> ("workqueue", (.name) value, (.loc) value)+  NPgmqDispatch value -> ("dispatch", (.name) value, (.loc) value)+  NReadModel value -> ("readmodel", (.name) value, (.loc) value)+  NProjectionTarget value -> ("target", (.name) value, (.loc) value)+  NRebuildGroup value -> ("rebuild-group", (.name) value, (.loc) value)+  NProjectionRevision value -> ("projection-revision", (.name) value, (.loc) value)+  NExternalRead value -> ("external-read", externalReadNodeIdentity value, (.loc) value)+  NProjectionOwner value -> ("projection-owner", (.name) value, (.loc) value)+  NWorkflow value -> ("workflow", (.id) value, workflowNodeLoc value)+  NOperation value -> ("operation", (.name) value, (.loc) value)  cabalPackageName :: Text -> Bool cabalPackageName packageName = not (null components) && all validComponent components

src/Keiro/Dsl/Parser.hs view

@@ -29,7 +29,7 @@ -- | Parse a @.keiro@ source. The 'FilePath' is used only as the source name in -- diagnostics; it need not exist on disk. parseSpec :: FilePath -> Text -> Either ParseError Spec-parseSpec sourceName input = parsedSpec <$> first renderParseFailure (parseSource sourceName input)+parseSpec sourceName input = (.spec) <$> first renderParseFailure (parseSource sourceName input)  -- | Convenience wrapper for callers without a source name (tests, stdin). parseSpecText :: Text -> Either ParseError Spec

src/Keiro/Dsl/Parser/Aggregate.hs view

@@ -38,7 +38,7 @@   let items = map snd positionedItems       transitions = [transition | BITransition transition _ <- items]       stateElements =-        [ mapLocated (SurfaceAggregateState name . stName) locatedState+        [ mapLocated (SurfaceAggregateState name . (.name)) locatedState         | locatedState <- locatedStates         ]       transitionElements =@@ -62,20 +62,20 @@     _ -> pure ()   pure     ( Aggregate-        { aggName = name,-          aggRegs = regs,-          aggStates = map locatedValue locatedStates,-          aggCommands = [c | BICommand c _ <- items],-          aggEvents = [e | BIEvent e _ <- items],-          aggTransitions = map locatedValue transitions,-          aggDomainOutcomeTypes = case outcomeDeclarations of+        { name = name,+          regs = regs,+          states = map locatedValue locatedStates,+          commands = [c | BICommand c _ <- items],+          events = [e | BIEvent e _ <- items],+          transitions = map locatedValue transitions,+          domainOutcomeTypes = case outcomeDeclarations of             declaration : _ -> Just declaration             [] -> Nothing,-          aggDomainOutcomeDuplicateLocs = map outcomeTypesLoc (drop 1 outcomeDeclarations),-          aggWire = listToMaybe [w | BIWire w <- items],-          aggProjection = listToMaybe [p | BIProjection p <- items],-          aggSnapshot = listToMaybe [s | BISnapshot s <- items],-          aggLoc = loc+          domainOutcomeDuplicateLocs = map (.outcomeTypesLoc) (drop 1 outcomeDeclarations),+          wire = listToMaybe [w | BIWire w <- items],+          projection = listToMaybe [p | BIProjection p <- items],+          snapshot = listToMaybe [s | BISnapshot s <- items],+          loc = loc         },       stateElements <> transitionElements <> concatMap bodyElements items     )@@ -117,7 +117,7 @@   ty <- pMappedTypeExpr context   _ <- symbol "="   initial <- (RegInitText <$> stringLit) <|> (RegInitBare <$> (ident <|> signedDecimalText))-  pure RegDecl {regName = name, regType = ty, regInitial = initial, regLoc = loc}+  pure RegDecl {name = name, valueType = ty, initial = initial, loc = loc}  pStatesLine :: P [Located StateDecl] pStatesLine = do@@ -139,7 +139,7 @@       n <- ident       term <- option False (True <$ symbol "!")       notFollowedBy (symbol "--")-      pure StateDecl {stName = n, stTerminal = term, stLoc = loc}+      pure StateDecl {name = n, terminal = term, loc = loc}  pBodyItem :: FrontendContext -> P BodyItem pBodyItem context =@@ -169,7 +169,7 @@   version <- boundedDecimal   _ <- symbol "shape-hash" *> symbol "="   hash <- stringLit-  pure SnapshotSpec {snapPolicy = policy, snapCodecVersion = version, snapShapeHash = hash, snapLoc = loc}+  pure SnapshotSpec {policy = policy, codecVersion = version, shapeHash = hash, loc = loc}  pCommand :: FrontendContext -> P (Command, [Located SurfaceElement]) pCommand context = do@@ -178,8 +178,8 @@   name <- ident   fields <- braces (many (withOwnedSpan (pAggregateField context)))   pure-    ( Command {cmdName = name, cmdFields = map locatedValue fields, cmdLoc = loc},-      map (mapLocated (SurfaceField . aggregateFieldName)) fields+    ( Command {name = name, fields = map locatedValue fields, loc = loc},+      map (mapLocated (SurfaceField . (.name))) fields     )  pAggregateField :: FrontendContext -> P AggregateField@@ -191,11 +191,11 @@   mty <- optional (symbol ":" *> pMappedTypeExpr context)   pure     AggregateField-      { aggregateFieldName = n,-        aggregateFieldSelector = selector,-        aggregateFieldWireKey = wireKey,-        aggregateFieldType = mty,-        aggregateFieldLoc = loc+      { name = n,+        selector = selector,+        wireKey = wireKey,+        valueType = mty,+        loc = loc       }  pEvent :: FrontendContext -> P (Event, [Located SurfaceElement])@@ -219,19 +219,19 @@           fields <- braces (many (withOwnedSpan (pAggregateField context)))           pure             ( EventFields (map locatedValue fields),-              map (mapLocated (SurfaceField . aggregateFieldName)) fields+              map (mapLocated (SurfaceField . (.name))) fields             )       ]   up <- optional pUpcast   pure     ( Event-        { evName = name,-          evBody = body,-          evVersion = ver,-          evUpcastFrom = up,-          evRetiring = retiring,-          evDeprecated = deprecated,-          evLoc = loc+        { name = name,+          body = body,+          version = ver,+          upcastFrom = up,+          retiring = retiring,+          deprecated = deprecated,+          loc = loc         },       elements     )@@ -256,7 +256,7 @@   _ <- symbol "schemaVersion"   _ <- symbol "="   v <- boundedDecimal-  pure WireSpec {wireKind = k, wireFields = f, wireSchemaVersion = v}+  pure WireSpec {kind = k, fields = f, schemaVersion = v}  pProjection :: FrontendContext -> P ProjectionSpec pProjection context = do@@ -278,11 +278,11 @@   sm <- optional pStatusMap   pure     ProjectionSpec-      { projTable = table,-        projConsistency = cons,-        projKey = k,-        projStatusMap = sm,-        projLoc = loc+      { table = table,+        consistency = cons,+        key = k,+        statusMap = sm,+        loc = loc       }   where     pConsistency =@@ -293,7 +293,7 @@   keyword "status-map"   partial <- option False (True <$ keyword "partial")   pairs <- braces (many pPair)-  pure Mapping {mapPairs = pairs, mapPartial = partial}+  pure Mapping {pairs = pairs, partial = partial}   where     pPair = do       l <- ident@@ -344,22 +344,22 @@   let guards = [e | CGuard e <- clauses]   pure     ( Transition-        { tSource = src,-          tCommand = cmd,-          tImplementation = case holeOffsets of+        { source = src,+          command = cmd,+          implementation = case holeOffsets of             _ : _ -> HoleImplementation             [] | frontendSupportsFeature context TypedAggregateExpressionSyntax -> GeneratedImplementation             [] -> LegacyHoleImplementation,-          tGuard = case guards of [] -> Nothing; es -> Just (foldr1 EAnd es),-          tWrites = [(r, e) | CWrite r e <- clauses],-          tEmits = [n | CEmit n <- clauses],-          tOutcome = case outcomes of+          guard = case guards of [] -> Nothing; es -> Just (foldr1 EAnd es),+          writes = [(r, e) | CWrite r e <- clauses],+          emits = [n | CEmit n <- clauses],+          outcome = case outcomes of             (_, outcome) : _ -> Just outcome             [] -> Nothing,-          tOutcomeDuplicateLocs = map (transitionOutcomeLoc . snd) (drop 1 outcomes),-          tGoto = gt,-          tMode = mode,-          tLoc = loc+          outcomeDuplicateLocs = map (transitionOutcomeLoc . snd) (drop 1 outcomes),+          goto = gt,+          mode = mode,+          loc = loc         },       elements     )

src/Keiro/Dsl/Parser/Coordination.hs view

@@ -41,18 +41,18 @@   timer <- pTimerNode   pure     ProcessNode-      { procId = pid,-        procName = nm,-        procInput = inp,-        procCorrelate = corr,-        procSaga = saga,-        procTarget = tgt,-        procProjections = projs,-        procHandle = handle,-        procRejected = rejected,-        procPoison = poison,-        procTimer = timer,-        procLoc = loc+      { id = pid,+        name = nm,+        input = inp,+        correlate = corr,+        saga = saga,+        target = tgt,+        projections = projs,+        handle = handle,+        rejected = rejected,+        poison = poison,+        timer = timer,+        loc = loc       }  pRouter :: FrontendContext -> P RouterNode@@ -65,7 +65,7 @@   (inp, typedInputSpan) <- pRouterInputDecl context   key <- pRouterKey (maybe False (const True) typedInputSpan)   resolved <- pResolveDecl context-  case (typedInputSpan, rvSource resolved) of+  case (typedInputSpan, (.source) resolved) of     (Just _, ResolveDeclarative {}) -> pure ()     (Nothing, ResolveReadModel {}) -> pure ()     (Nothing, ResolveHole) -> pure ()@@ -80,17 +80,17 @@   poison <- pPolicyLine "poison"   pure     RouterNode-      { rtId = rid,-        rtName = nm,-        rtInput = inp,-        rtKey = key,-        rtResolve = resolved,-        rtTarget = target,-        rtProjections = projections,-        rtDispatch = dispatch,-        rtRejected = rejected,-        rtPoison = poison,-        rtLoc = loc+      { id = rid,+        name = nm,+        input = inp,+        key = key,+        resolve = resolved,+        target = target,+        projections = projections,+        dispatch = dispatch,+        rejected = rejected,+        poison = poison,+        loc = loc       }  pRouterKey :: Bool -> P CorrelateDecl@@ -99,7 +99,7 @@   _ <- keyword "input" *> symbol "."   field <- ident   via <- if declarative then pure "idText" else keyword "via" *> ident-  pure CorrelateDecl {corrField = field, corrVia = via}+  pure CorrelateDecl {field = field, via = via}  pResolveDecl :: FrontendContext -> P ResolveDecl pResolveDecl context = do@@ -114,14 +114,14 @@   source <- choice [ResolveReadModel <$> (keyword "read-model" *> ident), ResolveHole <$ keyword "hole"]   keyword "row"   row <- braces (many ident)-  pure ResolveDecl {rvSource = source, rvRow = row, rvLoc = loc}+  pure ResolveDecl {source = source, row = row, loc = loc}  pDeclarativeResolve :: FrontendContext -> Loc -> P ResolveDecl pDeclarativeResolve context loc = do   marker <- withOwnedSpan (keyword "declarative")   requireLanguageFeatureAt context DeclarativeRouterSelectionSyntax (spanOf marker)   selection <- braces (pRouterSelection context loc)-  pure ResolveDecl {rvSource = ResolveDeclarative selection, rvRow = [], rvLoc = loc}+  pure ResolveDecl {source = ResolveDeclarative selection, row = [], loc = loc}  pRouterSelection :: FrontendContext -> Loc -> P RouterSelectionDecl pRouterSelection context loc = do@@ -157,30 +157,30 @@   (partial, partialLoc) <- locatedClause "partial" pSelectionPolicyName   pure     RouterSelectionDecl-      { rsIdentity = identity,-        rsIdentityLoc = identityLoc,-        rsVersion = version,-        rsVersionLoc = versionLoc,-        rsQuery = query,-        rsQueryLoc = queryLoc,-        rsQueryInput = queryInput,-        rsQueryInputLoc = queryInputLoc,-        rsPredicate = predicate,-        rsRecipient = recipient,-        rsLimit = recipientLimit,-        rsOrder = order,-        rsOrderLoc = orderLoc,-        rsDedupe = dedupe,-        rsDedupeLoc = dedupeLoc,-        rsEmptyPolicy = emptyPolicy,-        rsEmptyPolicyLoc = emptyPolicyLoc,-        rsFailurePolicy = failurePolicy,-        rsFailurePolicyLoc = failurePolicyLoc,-        rsRedelivery = redelivery,-        rsRedeliveryLoc = redeliveryLoc,-        rsPartial = partial,-        rsPartialLoc = partialLoc,-        rsLoc = loc+      { identity = identity,+        identityLoc = identityLoc,+        version = version,+        versionLoc = versionLoc,+        query = query,+        queryLoc = queryLoc,+        queryInput = queryInput,+        queryInputLoc = queryInputLoc,+        predicate = predicate,+        recipient = recipient,+        limit = recipientLimit,+        order = order,+        orderLoc = orderLoc,+        dedupe = dedupe,+        dedupeLoc = dedupeLoc,+        emptyPolicy = emptyPolicy,+        emptyPolicyLoc = emptyPolicyLoc,+        failurePolicy = failurePolicy,+        failurePolicyLoc = failurePolicyLoc,+        redelivery = redelivery,+        redeliveryLoc = redeliveryLoc,+        partial = partial,+        partialLoc = partialLoc,+        loc = loc       }  locatedClause :: Text -> P a -> P (a, Loc)@@ -214,7 +214,7 @@       <$> (keyword "on-appended" *> pDisp)       <*> (symbol ";" *> keyword "on-duplicate" *> pDisp)       <*> (symbol ";" *> keyword "on-failed" *> pDisp)-  pure RouterDispatchNode {rdCommand = command, rdFields = fields, rdDisposition = disposition, rdLoc = loc}+  pure RouterDispatchNode {command = command, fields = fields, disposition = disposition, loc = loc}  -- | @dispatch-id strategy=uuidv5 from=(…)@ where the tuple is fixed by the -- runtime that derives the id. The line documents a derivation the spec cannot@@ -250,7 +250,7 @@   keyword "input"   nm <- ident   fs <- braces (many pField)-  pure InputDecl {inName = nm, inFields = fs, inType = Nothing, inLoc = loc}+  pure InputDecl {name = nm, fields = fs, valueType = Nothing, loc = loc}  pRouterInputDecl :: FrontendContext -> P (InputDecl, Maybe SourceSpan) pRouterInputDecl context = do@@ -261,10 +261,10 @@     [ do         marker <- withOwnedSpan (symbol ":")         inputType <- pMappedTypeExpr context-        pure (InputDecl {inName = name, inFields = [], inType = Just inputType, inLoc = loc}, Just (spanOf marker)),+        pure (InputDecl {name = name, fields = [], valueType = Just inputType, loc = loc}, Just (spanOf marker)),       do         fields <- braces (many pField)-        pure (InputDecl {inName = name, inFields = fields, inType = Nothing, inLoc = loc}, Nothing)+        pure (InputDecl {name = name, fields = fields, valueType = Nothing, loc = loc}, Nothing)     ]  pCorrelate :: P CorrelateDecl@@ -274,7 +274,7 @@   f <- ident   keyword "via"   v <- ident-  pure CorrelateDecl {corrField = f, corrVia = v}+  pure CorrelateDecl {field = f, via = v}  pSaga :: P SagaRef pSaga = do@@ -282,7 +282,7 @@   agg <- ident   keyword "category"   categoryName <- stringLit-  pure SagaRef {sagaAgg = agg, sagaCategory = categoryName}+  pure SagaRef {agg = agg, category = categoryName}  pHandle :: P HandleNode pHandle = do@@ -292,7 +292,7 @@   disps <- many pDispatch   keyword "schedule"   sched <- ident-  pure HandleNode {hOn = onName, hAdvance = adv, hDispatch = disps, hSchedule = sched}+  pure HandleNode {on = onName, advance = adv, dispatch = disps, schedule = sched}  pAdvance :: P AdvanceNode pAdvance = do@@ -315,7 +315,7 @@       <$> (keyword "on-appended" *> pDisp)       <*> (symbol ";" *> keyword "on-duplicate" *> pDisp)       <*> (symbol ";" *> keyword "on-failed" *> pDisp)-  pure DispatchNode {dispTarget = tgt, dispKey = key, dispCommand = cmd, dispFields = fs, dispDisposition = disp, dispLoc = loc}+  pure DispatchNode {target = tgt, key = key, command = cmd, fields = fs, disposition = disp, loc = loc}  pDisp :: P Disp pDisp =@@ -353,15 +353,15 @@   dl <- stringLit   pure     TimerNode-      { tmName = nm,-        tmId = tid,-        tmFireAt = fat,-        tmPayload = pay,-        tmFire = fire,-        tmDecodeUnknown = unk,-        tmMaxAttempts = ma,-        tmDeadLetter = dl,-        tmLoc = loc+      { name = nm,+        id = tid,+        fireAt = fat,+        payload = pay,+        fire = fire,+        decodeUnknown = unk,+        maxAttempts = ma,+        deadLetter = dl,+        loc = loc       }  pIdExpr :: P IdExpr@@ -370,7 +370,7 @@   pfx <- stringLit   _ <- symbol "<>"   field <- ident-  pure IdExpr {ideStrategy = UuidV5Id, idePrefix = pfx, ideField = field}+  pure IdExpr {strategy = UuidV5Id, prefix = pfx, field = field}  pFireAt :: P FireAtExpr pFireAt = do@@ -378,7 +378,7 @@   f <- ident   _ <- symbol "+"   w <- pWindow-  pure FireAtExpr {faField = f, faWindow = w}+  pure FireAtExpr {field = f, window = w}  pFire :: P FireNode pFire = do@@ -397,7 +397,7 @@       <*> (symbol ";" *> keyword "on-ambiguous" *> pFireOutcome)       <*> (symbol ";" *> keyword "on-error" *> pFireOutcome)       <*> (symbol ";" *> keyword "not-mine" *> pFireOutcome)-  pure FireNode {fireTarget = tgt, fireKey = key, fireCommand = cmd, fireFields = fs, fireFiredEventId = fid, fireDisposition = disp}+  pure FireNode {target = tgt, key = key, command = cmd, fields = fs, firedEventId = fid, disposition = disp}  pFireOutcome :: P FireOutcome pFireOutcome = choice [OFired <$ keyword "Fired", ORetry <$ keyword "Retry"]@@ -406,7 +406,7 @@ pFieldBinding = do   n <- ident   v <- optional (symbol "=" *> pBindingValue)-  pure FieldBinding {fbName = n, fbValue = v}+  pure FieldBinding {name = n, value = v}  -- | A binding value: a quoted string (kept quoted) or a dotted reference. pBindingValue :: P Text

src/Keiro/Dsl/Parser/Core.hs view

@@ -72,14 +72,14 @@ import Prelude hiding (span)  data ContextualParseFailure = ContextualParseFailure-  { contextualFailureCode :: !SourceLanguageErrorCode,-    contextualFailureFeature :: !(Maybe LanguageFeature),-    contextualFailureSpan :: !SourceSpan+  { code :: !SourceLanguageErrorCode,+    feature :: !(Maybe LanguageFeature),+    span :: !SourceSpan   }   deriving stock (Eq, Ord, Show)  instance ShowErrorComponent ContextualParseFailure where-  showErrorComponent contextual = T.unpack (sourceLanguageErrorCodeText (contextualFailureCode contextual))+  showErrorComponent contextual = T.unpack (sourceLanguageErrorCodeText ((.code) contextual))  type P = Parsec ContextualParseFailure Text @@ -116,7 +116,7 @@  contextualFailureAt :: SourceSpan -> SourceLanguageErrorCode -> P a contextualFailureAt span code =-  customFailure ContextualParseFailure {contextualFailureCode = code, contextualFailureFeature = Nothing, contextualFailureSpan = span}+  customFailure ContextualParseFailure {code = code, feature = Nothing, span = span}  requireLanguageFeatureAt :: FrontendContext -> LanguageFeature -> SourceSpan -> P () requireLanguageFeatureAt context feature span@@ -124,9 +124,9 @@   | otherwise =       customFailure         ContextualParseFailure-          { contextualFailureCode = LanguageFeatureRequiresVersion,-            contextualFailureFeature = Just feature,-            contextualFailureSpan = span+          { code = LanguageFeatureRequiresVersion,+            feature = Just feature,+            span = span           }  -- | Space consumer: spaces, newlines, and @#@ line comments are all whitespace.@@ -369,7 +369,7 @@ pField = do   n <- ident   mty <- optional (symbol ":" *> ident)-  pure Field {fieldName = n, fieldType = mty}+  pure Field {name = n, valueType = mty}  pVersion :: P Int pVersion = do

src/Keiro/Dsl/Parser/Declaration.hs view

@@ -25,7 +25,7 @@   _ <- symbol "="   pfx <- wireWord   binding <- optionalLanguageFeature context NominalBindingSyntax "using" pUsingNominalBinding-  pure IdDecl {idName = name, idPrefix = pfx, idBinding = binding, idLoc = loc}+  pure IdDecl {name = name, prefix = pfx, binding = binding, loc = loc}  pEnumDecl :: FrontendContext -> P EnumDecl pEnumDecl context = do@@ -34,7 +34,7 @@   name <- ident   ctors <- braces (many pEnumCtor)   binding <- optionalLanguageFeature context NominalBindingSyntax "using" pUsingNominalBinding-  pure EnumDecl {enumName = name, enumCtors = ctors, enumBinding = binding, enumLoc = loc}+  pure EnumDecl {name = name, ctors = ctors, binding = binding, loc = loc}   where     pEnumCtor = do       c <- ident@@ -57,11 +57,11 @@       elements = map snd parsedCases   pure     ( RuleDecl-        { ruleName = name,-          ruleDomain = dom,-          ruleCodomain = cod,-          ruleCases = cases,-          ruleLoc = loc+        { name = name,+          domain = dom,+          codomain = cod,+          cases = cases,+          loc = loc         },       elements     )

src/Keiro/Dsl/Parser/Document.hs view

@@ -48,8 +48,8 @@             Left bundle -> case firstContextualFailure bundle of               Just contextual ->                 let diagnostic = contextualDiagnostic src sourceLanguage contextual-                    supported = languageVersionsSupportingFeature <$> contextualFailureFeature contextual-                 in Left (frontendFailureFromSourceDiagnostic BodyParsingPhase (contextualFailureSpan contextual) supported diagnostic)+                    supported = languageVersionsSupportingFeature <$> (.feature) contextual+                 in Left (frontendFailureFromSourceDiagnostic BodyParsingPhase ((.span) contextual) supported diagnostic)               Nothing ->                 Left                   ( frontendFailureFromBody

src/Keiro/Dsl/Parser/Integration.hs view

@@ -31,12 +31,12 @@   _ <- symbol "}"   pure     ContractNode-      { ctrName = nm,-        ctrSchemaVersion = sv,-        ctrDiscriminator = disc,-        ctrTopics = topics,-        ctrEvents = events,-        ctrLoc = loc+      { name = nm,+        schemaVersion = sv,+        discriminator = disc,+        topics = topics,+        events = events,+        loc = loc       }   where     pTopic = do@@ -50,7 +50,7 @@       keyword "on"       topicAlias <- ident       fs <- braces (many pContractField)-      pure ContractEvent {ceName = nm, ceTopic = topicAlias, ceFields = fs}+      pure ContractEvent {name = nm, topic = topicAlias, fields = fs}     pContractField = do       loc <- getLoc       n <- ident@@ -59,7 +59,7 @@       _ <- symbol ":"       ty <- pContractType       _ <- optional (symbol ";")-      pure ContractField {cfName = n, cfSelector = selector, cfWireKey = wireKey, cfType = ty, cfLoc = loc}+      pure ContractField {name = n, selector = selector, wireKey = wireKey, valueType = ty, loc = loc}     pContractType =       choice         [ CTypeId <$> (keyword "typeid" *> stringLit),@@ -98,17 +98,17 @@   _ <- symbol "}"   pure     IntakeNode-      { inkName = nm,-        inkContract = ctr,-        inkTopic = tp,-        inkAccept = acc,-        inkBinds = binds,-        inkDedupeKey = dk,-        inkDedupePolicy = dp,-        inkPersist = persistence,-        inkDecode = dec,-        inkDisposition = disp,-        inkLoc = loc+      { name = nm,+        contract = ctr,+        topic = tp,+        accept = acc,+        binds = binds,+        dedupeKey = dk,+        dedupePolicy = dp,+        persist = persistence,+        decode = dec,+        disposition = disp,+        loc = loc       }   where     pBindRow = do@@ -118,7 +118,7 @@       src <- pWireSource       req <- option False (True <$ keyword "required")       xc <- option False (True <$ (keyword "cross-check" *> keyword "body"))-      pure BindRow {brField = f, brSource = src, brRequired = req, brCrossCheck = xc}+      pure BindRow {field = f, source = src, required = req, crossCheck = xc}     pWireSource =       choice         [ SrcHeader <$> (keyword "header" *> stringLit),@@ -137,7 +137,7 @@       _ <- symbol "=="       v <- boundedDecimal       _ <- symbol "}"-      pure DecodeSpec {decEnvelope = env, decBodyStrict = strict, decBodySchemaVersion = v}+      pure DecodeSpec {envelope = env, bodyStrict = strict, bodySchemaVersion = v}     pEnvelopePolicy = do       a <- wireWord       b <- wireWord@@ -151,7 +151,7 @@       o <- ident       _ <- symbol "=>"       act <- pInboxAction-      pure DispositionRow {drOutcome = o, drAction = act, drLoc = loc}+      pure DispositionRow {outcome = o, action = act, loc = loc}     pInboxAction =       choice         [ IAckOk <$ keyword "ackOk",@@ -183,17 +183,17 @@   _ <- symbol "}"   pure     EmitNode-      { emName = nm,-        emContract = ctr,-        emTopic = tp,-        emSource = src,-        emKey = k,-        emDiscriminant = disc,-        emMap = rows,-        emSkip = skip,-        emMessageId = mid,-        emIdempotencyKey = idk,-        emLoc = loc+      { name = nm,+        contract = ctr,+        topic = tp,+        source = src,+        key = k,+        discriminant = disc,+        map = rows,+        skip = skip,+        messageId = mid,+        idempotencyKey = idk,+        loc = loc       }   where     pMapRows = do@@ -205,7 +205,7 @@       v <- stringLit       _ <- symbol "=>"       ev <- ident-      pure EmitMapRow {emrValue = v, emrEvent = ev, emrLoc = loc}+      pure EmitMapRow {value = v, event = ev, loc = loc}     pDerive = do       keyword "derive"       pfx <- optional stringLit@@ -236,11 +236,11 @@   _ <- symbol "}"   pure     PublisherNode-      { pubName = nm,-        pubEmit = em,-        pubOrdering = ord,-        pubMaxAttempts = ma,-        pubBackoff = BackoffSpec {boKind = bk, boWindow = bw, boMax = bm, boMultiplier = multiplier},-        pubOutboxField = obf,-        pubLoc = loc+      { name = nm,+        emit = em,+        ordering = ord,+        maxAttempts = ma,+        backoff = BackoffSpec {kind = bk, window = bw, max = bm, multiplier = multiplier},+        outboxField = obf,+        loc = loc       }

src/Keiro/Dsl/Parser/Mapped.hs view

@@ -107,10 +107,10 @@   binding <- pNominalBindingBlock loc   pure     NominalScalarDecl-      { nominalScalarName = name,-        nominalScalarRepresentation = representation,-        nominalScalarBinding = binding,-        nominalScalarLoc = loc+      { name = name,+        representation = representation,+        binding = binding,+        loc = loc       }  pUsingNominalBinding :: P NominalBindingDecl@@ -130,13 +130,13 @@   initial <- oneClause "initial" (\case MCInitial value -> Just value; _ -> Nothing) clauses   pure     NominalBindingDecl-      { nominalHaskell = hs,-        nominalBinding = binding,-        nominalBindingVersion = bindingVersion,-        nominalCanonicalType = canonical,-        nominalFixtures = fixtures,-        nominalInitial = initial,-        nominalLoc = loc+      { haskell = hs,+        binding = binding,+        bindingVersion = bindingVersion,+        canonicalType = canonical,+        fixtures = fixtures,+        initial = initial,+        loc = loc       }  pNominalClause :: P MappedClause@@ -184,7 +184,7 @@   keyword "type"   _ <- symbol "="   typeName <- ident-  pure HaskellSource {hsPackage = packageName, hsModule = moduleName, hsType = typeName}+  pure HaskellSource {package = packageName, moduleName = moduleName, valueType = typeName}  pQuotedFact :: Text -> P Text pQuotedFact factName = keyword factName *> symbol "=" *> stringLit@@ -229,17 +229,17 @@   keyword "as"   wireKey <- stringLit   _ <- symbol ":"-  fieldType <- pMappedTypeExpr context+  valueType <- pMappedTypeExpr context   presence <- choice [PRequired <$ keyword "required", POptional <$ keyword "optional"]   onMissing <- optional (keyword "on-missing" *> symbol "=" *> pOnMissing)   pure     WireField-      { wfHaskell = haskellName,-        wfKey = wireKey,-        wfType = fieldType,-        wfPresence = presence,-        wfOnMissing = onMissing,-        wfLoc = loc+      { haskell = haskellName,+        key = wireKey,+        valueType = valueType,+        presence = presence,+        onMissing = onMissing,+        loc = loc       }  pWireEnum :: P WireEnum@@ -248,7 +248,7 @@   constructor <- ident   keyword "as"   wireTag <- stringLit-  pure WireEnum {weCtor = constructor, weTag = wireTag, weLoc = loc}+  pure WireEnum {ctor = constructor, tag = wireTag, loc = loc}  pWireArm :: FrontendContext -> P WireArm pWireArm context = do@@ -257,7 +257,7 @@   keyword "as"   wireTag <- stringLit   payload <- optional (symbol ":" *> pMappedTypeExpr context)-  pure WireArm {waCtor = constructor, waTag = wireTag, waPayload = payload, waLoc = loc}+  pure WireArm {ctor = constructor, tag = wireTag, payload = payload, loc = loc}  pMappedTypeExpr :: FrontendContext -> P TypeExpr pMappedTypeExpr context =

src/Keiro/Dsl/Parser/Preamble.hs view

@@ -23,24 +23,24 @@ contextualDiagnostic :: FilePath -> SourceLanguage -> ContextualParseFailure -> SourceLanguageDiagnostic contextualDiagnostic src sourceLanguage contextual =   SourceLanguageDiagnostic-    { sourceLanguageErrorCode = code,-      sourceLanguageSource = src,-      sourceLanguageLoc = Loc line,-      sourceLanguageToken = case code of+    { errorCode = code,+      source = src,+      loc = Loc line,+      token = case code of         LanguageFeatureRequiresVersion -> Just (languageVersionText effectiveVersion)         _ -> Nothing,-      sourceLanguageDeclaredVersion = case code of+      declaredVersion = case code of         LanguageFeatureRequiresVersion -> Just effectiveVersion         _ -> Nothing,-      sourceLanguageSupportedVersions = case contextualFailureFeature contextual of+      supportedVersions = case (.feature) contextual of         Nothing -> supportedLanguageVersions         Just feature -> case NE.nonEmpty (languageVersionsSupportingFeature feature) of           Just versions -> versions           Nothing -> supportedLanguageVersions     }   where-    code = contextualFailureCode contextual-    SourceSpan {start = SourcePoint {line}} = contextualFailureSpan contextual+    code = (.code) contextual+    SourceSpan {start = SourcePoint {line}} = (.span) contextual     effectiveVersion = effectiveLanguageVersion sourceLanguage  -- | Consume a preamble already validated by 'selectSourceLanguage'. This@@ -57,8 +57,8 @@ -- leading whitespace and comments. Body lines are left entirely to -- 'pSurfaceSpec'. data InitialLanguageClause = InitialLanguageClause-  { initialLanguageSpan :: !SourceSpan,-    initialLanguageText :: !Text+  { span :: !SourceSpan,+    text :: !Text   }  selectSourceLanguage :: FilePath -> Text -> Either FrontendFailure SourceLanguage@@ -80,23 +80,23 @@       version <- parsePreamble languageClause       case lookupLanguageDefinition version of         Nothing -> Left (sourceFailure UnsupportedLanguageVersion languageClause (Just (languageVersionText version)) (Just version))-        Just _ -> Right (DeclaredLanguage version (Loc (startLine (initialLanguageSpan languageClause))))+        Just _ -> Right (DeclaredLanguage version (Loc (startLine ((.span) languageClause))))   where     sourceFailure code line tokenText declared =       frontendFailureFromSourceDiagnostic         SourceSelectionPhase-        (initialLanguageSpan line)+        ((.span) line)         Nothing         SourceLanguageDiagnostic-          { sourceLanguageErrorCode = code,-            sourceLanguageSource = src,-            sourceLanguageLoc = Loc (startLine (initialLanguageSpan line)),-            sourceLanguageToken = tokenText,-            sourceLanguageDeclaredVersion = declared,-            sourceLanguageSupportedVersions = supportedLanguageVersions+          { errorCode = code,+            source = src,+            loc = Loc (startLine ((.span) line)),+            token = tokenText,+            declaredVersion = declared,+            supportedVersions = supportedLanguageVersions           } -    parsePreamble line = case T.words (initialLanguageText line) of+    parsePreamble line = case T.words ((.text) line) of       ["language", "keiro-dsl", tokenText]         | T.all (\c -> isAscii c && isDigit c) tokenText && not (T.null tokenText) ->             case TR.decimal tokenText :: Either String (Natural, Text) of@@ -117,4 +117,4 @@       locatedLine <- withOwnedSpan (takeWhileP (Just "language preamble") (\c -> c /= '\n' && c /= '\r'))       let rawLine = locatedValue locatedLine       let content = T.strip (T.takeWhile (/= '#') rawLine)-      pure InitialLanguageClause {initialLanguageSpan = spanOf locatedLine, initialLanguageText = content}+      pure InitialLanguageClause {span = spanOf locatedLine, text = content}

src/Keiro/Dsl/Parser/ProjectionCatalog.hs view

@@ -26,7 +26,7 @@   reset <- symbol "reset" *> symbol "=" *> pReset   dependsOn <- option [] (try (symbol "depends-on" *> symbol "=" *> brackets (many ident)))   _ <- symbol "}"-  pure ProjectionTargetNode {ptName = name, ptSchema = schema, ptTable = table, ptReset = reset, ptDependsOn = dependsOn, ptLoc = loc}+  pure ProjectionTargetNode {name = name, schema = schema, table = table, reset = reset, dependsOn = dependsOn, loc = loc}   where     pReset = choice [TargetClear <$ keyword "clear", TargetPreserve <$ keyword "preserve"] @@ -40,7 +40,7 @@   targets <- symbol "targets" *> symbol "=" *> brackets (many ident)   order <- symbol "order" *> symbol "=" *> brackets (many ident)   _ <- symbol "}"-  pure RebuildGroupNode {rgName = name, rgTargets = targets, rgOrder = order, rgLoc = loc}+  pure RebuildGroupNode {name = name, targets = targets, order = order, loc = loc}  pProjectionRevision :: FrontendContext -> P ProjectionRevisionNode pProjectionRevision context = do@@ -52,7 +52,7 @@   group <- symbol "group" *> symbol "=" *> ident   revisionTargets <- many pRevisionTarget   _ <- symbol "}"-  pure ProjectionRevisionNode {prvName = name, prvGroup = group, prvTargets = revisionTargets, prvLoc = loc}+  pure ProjectionRevisionNode {name = name, group = group, targets = revisionTargets, loc = loc}   where     pRevisionTarget = do       _ <- keyword "target"@@ -68,14 +68,14 @@       _ <- symbol "}"       pure         RevisionTargetNode-          { prtTarget = targetName,-            prtSchemaVersion = schemaVersion,-            prtProvisioner = provisioner,-            prtProvisionerVersion = provisionerVersion,-            prtExpectedShape = expectedShape,-            prtValidator = validator,-            prtValidatorVersion = validatorVersion,-            prtPromotionObjects = promotionObjects+          { target = targetName,+            schemaVersion = schemaVersion,+            provisioner = provisioner,+            provisionerVersion = provisionerVersion,+            expectedShape = expectedShape,+            validator = validator,+            validatorVersion = validatorVersion,+            promotionObjects = promotionObjects           }     pPromotionObject = do       _ <- keyword "promotion"@@ -106,14 +106,14 @@   _ <- symbol "}"   pure     ExternalReadNode-      { erName = name,-        erVersion = version,-        erQueryModel = queryModel,-        erResultSchema = resultSchema,-        erResultType = resultType,-        erCompatibleRevisions = compatibleRevisions,-        erSurfaceGeneration = surfaceGeneration,-        erLoc = loc+      { name = name,+        version = version,+        queryModel = queryModel,+        resultSchema = resultSchema,+        resultType = resultType,+        compatibleRevisions = compatibleRevisions,+        surfaceGeneration = surfaceGeneration,+        loc = loc       }  pProjectionOwner :: FrontendContext -> P ProjectionOwnerNode@@ -135,17 +135,17 @@   _ <- symbol "}"   pure     ProjectionOwnerNode-      { poName = name,-        poSources = sources,-        poDelivery = delivery,-        poGroup = group,-        poTargets = targets,-        poOrder = ownerOrder,-        poSubscription = subscription,-        poDedup = dedup,-        poCheckpointOnMissing = checkpointOnMissing,-        poReplay = replay,-        poLoc = loc+      { name = name,+        sources = sources,+        delivery = delivery,+        group = group,+        targets = targets,+        order = ownerOrder,+        subscription = subscription,+        dedup = dedup,+        checkpointOnMissing = checkpointOnMissing,+        replay = replay,+        loc = loc       }   where     pSource = symbol "source" *> symbol "=" *> choice [CatalogAggregate <$> (keyword "aggregate" *> ident), CatalogCategory <$> (keyword "category" *> stringLit), CatalogAll <$ keyword "all"]

src/Keiro/Dsl/Parser/Queue.hs view

@@ -46,21 +46,21 @@   _ <- symbol "}"   pure     WorkqueueNode-      { wqName = nm,-        wqLogical = logical,-        wqPhysical = phys,-        wqDlq = dlqName,-        wqTable = tbl,-        wqOrdering = ordering,-        wqGroupKey = groupKey,-        wqProvision = provision,-        wqPayloadName = pn,-        wqPayload = fields,-        wqMaxRetries = mr,-        wqDelay = dl,-        wqDlqOn = dlqOn,-        wqDisposition = disp,-        wqLoc = loc+      { name = nm,+        logical = logical,+        physical = phys,+        dlq = dlqName,+        table = tbl,+        ordering = ordering,+        groupKey = groupKey,+        provision = provision,+        payloadName = pn,+        payload = fields,+        maxRetries = mr,+        delay = dl,+        dlqOn = dlqOn,+        disposition = disp,+        loc = loc       }   where     pOrdering = do@@ -76,7 +76,7 @@       _ <- symbol "via"       via <- ident       fixture <- optional (symbol "fixture" *> stringLit)-      pure WqGroupKey {gkField = field, gkVia = via, gkFixture = fixture}+      pure WqGroupKey {field = field, via = via, fixture = fixture}     pProvision = do       _ <- symbol "provision"       choice@@ -101,7 +101,7 @@       -- of them. The keyword stays accepted so existing sources still parse, but       -- it selects nothing, so it is not retained. See ExecPlan 199.       _ <- optional (keyword "required")-      pure WqField {wqfName = n, wqfWire = w, wqfType = ty, wqfLoc = loc}+      pure WqField {name = n, wire = w, valueType = ty, loc = loc}     pTypedPayload = do       marker <- withOwnedSpan (symbol ":")       requireLanguageFeatureAt context MappedConsumerSurfaceSyntax (spanOf marker)@@ -119,7 +119,7 @@       o <- ident       _ <- symbol "->"       act <- choice [IAckOk <$ keyword "ackOk", IRetry <$> (keyword "retry" *> pWindow), IDeadLetter <$> (keyword "deadLetter" *> optional stringLit)]-      pure WqDispRow {wqdOutcome = o, wqdAction = act, wqdLoc = loc}+      pure WqDispRow {outcome = o, action = act, loc = loc}  pPgmqDispatch :: P PgmqDispatchNode pPgmqDispatch = do@@ -152,15 +152,15 @@   _ <- symbol "}"   pure     PgmqDispatchNode-      { pdName = nm,-        pdSourceReadModel = srm,-        pdSourceKey = sk,-        pdFanoutBody = fb,-        pdDedupKey = dk,-        pdDedupReadModel = drm,-        pdDedupReadModelField = drmf,-        pdDedupQueue = dq,-        pdDedupQueueField = dqf,-        pdEnqueueTo = enq,-        pdLoc = loc+      { name = nm,+        sourceReadModel = srm,+        sourceKey = sk,+        fanoutBody = fb,+        dedupKey = dk,+        dedupReadModel = drm,+        dedupReadModelField = drmf,+        dedupQueue = dq,+        dedupQueueField = dqf,+        enqueueTo = enq,+        loc = loc       }

src/Keiro/Dsl/Parser/ReadModel.hs view

@@ -52,19 +52,19 @@   _ <- symbol "}"   pure     ReadModelNode-      { rmName = name,-        rmTable = table,-        rmSchema = schema,-        rmColumns = columns,-        rmVersion = version,-        rmShape = shape,-        rmFreshness = freshness,-        rmSupply = supply,-        rmGroup = group,-        rmObservedTargets = observedTargets,-        rmBackingTarget = backingTarget,+      { name = name,+        table = table,+        schema = schema,+        columns = columns,+        version = version,+        shape = shape,+        freshness = freshness,+        supply = supply,+        group = group,+        observedTargets = observedTargets,+        backingTarget = backingTarget,         queryTypes,-        rmLoc = loc+        loc = loc       }   where     pColumn =

src/Keiro/Dsl/Parser/Workflow.hs view

@@ -19,7 +19,7 @@   nm <- stringLit   keyword "in"   inTy <- ident-  inFields <- option [] (braces (many pField))+  fields <- option [] (braces (many pField))   keyword "out"   outTy <- ident   keyword "id"@@ -32,15 +32,15 @@   body <- many pWfBodyItem   pure     WorkflowNode-      { wfId = wid,-        wfStable = nm,-        wfInput = inTy,-        wfInputFields = inFields,-        wfOutput = outTy,-        wfIdField = idField,-        wfIdVia = idVia,-        wfBody = body,-        wfLoc = loc+      { id = wid,+        stable = nm,+        input = inTy,+        inputFields = fields,+        output = outTy,+        idField = idField,+        idVia = idVia,+        body = body,+        loc = loc       }   where     pWfBodyItem =@@ -84,7 +84,7 @@         pSignalOp,         pRunOp       ]-  pure OperationNode {opName = nm, opShape = shape, opLoc = loc}+  pure OperationNode {name = nm, shape = shape, loc = loc}   where     pCommandOp = do       keyword "command"

src/Keiro/Dsl/PrettyPrint.hs view

@@ -31,7 +31,7 @@  -- | Render a source while preserving whether it explicitly declared a version. renderSource :: ParsedSource -> Text-renderSource ParsedSource {parsedSourceLanguage = sourceLanguage, parsedSpec = spec} =+renderSource ParsedSource {sourceLanguage = sourceLanguage, spec = spec} =   case sourceLanguage of     LegacyUnversioned -> renderSpec spec     DeclaredLanguage {declaredLanguageVersion = version} ->@@ -48,7 +48,7 @@  renderTimerPayloadSurface :: TimerNode -> Text renderTimerPayloadSurface timer =-  renderDoc ("payload" <+> braced (map docFieldBinding (tmPayload timer)))+  renderDoc ("payload" <+> braced (map docFieldBinding ((.payload) timer)))  renderTypeExpr :: TypeExpr -> Text renderTypeExpr = renderDoc . docTypeExpr@@ -59,21 +59,21 @@ docSpec :: Spec -> Doc ann docSpec s =   vsep $-    ["context" <+> pretty (specContext s)]-      ++ maybe [] (\r -> ["module" <+> pretty r]) (specModuleRoot s)-      ++ maybe [] (\l -> ["layout" <+> docLayout l]) (specLayout s)+    ["context" <+> pretty ((.context) s)]+      ++ maybe [] (\r -> ["module" <+> pretty r]) ((.moduleRoot) s)+      ++ maybe [] (\l -> ["layout" <+> docLayout l]) ((.layout) s)       ++ [mempty]-      ++ map docId (specIds s)-      ++ blankAfter (specIds s)-      ++ map docEnum (specEnums s)-      ++ blankAfter (specEnums s)-      ++ map docRule (specRules s)-      ++ blankAfter (specRules s)-      ++ map docNominalScalar (specNominalScalars s)-      ++ blankAfter (specNominalScalars s)-      ++ map docMapped (specMapped s)-      ++ blankAfter (specMapped s)-      ++ map docNode (specNodes s)+      ++ map docId ((.ids) s)+      ++ blankAfter ((.ids) s)+      ++ map docEnum ((.enums) s)+      ++ blankAfter ((.enums) s)+      ++ map docRule ((.rules) s)+      ++ blankAfter ((.rules) s)+      ++ map docNominalScalar ((.nominalScalars) s)+      ++ blankAfter ((.nominalScalars) s)+      ++ map docMapped ((.mapped) s)+      ++ blankAfter ((.mapped) s)+      ++ map docNode ((.nodes) s)   where     blankAfter xs = if null xs then [] else [mempty] @@ -83,17 +83,17 @@  docId :: IdDecl -> Doc ann docId d =-  case idBinding d of-    Nothing -> "id" <+> pretty (idName d) <+> ("prefix=" <> pretty (idPrefix d))+  case (.binding) d of+    Nothing -> "id" <+> pretty ((.name) d) <+> ("prefix=" <> pretty ((.prefix) d))     Just binding ->       vsep $-        ["id" <+> pretty (idName d) <+> ("prefix=" <> pretty (idPrefix d)) <+> "using" <+> "{"]+        ["id" <+> pretty ((.name) d) <+> ("prefix=" <> pretty ((.prefix) d)) <+> "using" <+> "{"]           ++ map (indent 2) (docNominalBindingFacts binding)           ++ ["}"]  docEnum :: EnumDecl -> Doc ann docEnum d =-  case enumBinding d of+  case (.binding) d of     Nothing -> enumHeader     Just binding ->       vsep $@@ -101,14 +101,14 @@           ++ map (indent 2) (docNominalBindingFacts binding)           ++ ["}"]   where-    enumHeader = "enum" <+> pretty (enumName d) <+> braced (map ctor (enumCtors d))+    enumHeader = "enum" <+> pretty ((.name) d) <+> braced (map ctor ((.ctors) d))     ctor (c, w) = pretty c <> "=" <> pretty w  docRule :: RuleDecl -> Doc ann docRule d =   vsep-    [ "rule" <+> pretty (ruleName d) <+> ":" <+> pretty (ruleDomain d) <+> "->" <+> pretty (ruleCodomain d),-      indent 2 ("ex" <+> hsep (punctuate " ;" (map cas (ruleCases d))))+    [ "rule" <+> pretty ((.name) d) <+> ":" <+> pretty ((.domain) d) <+> "->" <+> pretty ((.codomain) d),+      indent 2 ("ex" <+> hsep (punctuate " ;" (map cas ((.cases) d))))     ]   where     cas (c, e) = pretty c <+> "=>" <+> docExpr 0 e@@ -138,22 +138,22 @@ docNominalScalar declaration =   vsep $     [ "mapped nominal"-        <+> pretty (nominalScalarName declaration)+        <+> pretty ((.name) declaration)         <+> ":"-        <+> pretty (nominalScalarRepresentation declaration)+        <+> pretty ((.representation) declaration)         <+> "{"     ]-      ++ map (indent 2) (docNominalBindingFacts (nominalScalarBinding declaration))+      ++ map (indent 2) (docNominalBindingFacts ((.binding) declaration))       ++ ["}"]  docNominalBindingFacts :: NominalBindingDecl -> [Doc ann] docNominalBindingFacts binding =-  maybe [] (pure . docHaskellSource) (nominalHaskell binding)-    ++ maybe [] (pure . docQuotedFact "binding") (nominalBinding binding)-    ++ maybe [] (pure . docQuotedFact "binding-version") (nominalBindingVersion binding)-    ++ maybe [] (pure . docQuotedFact "canonical-type") (nominalCanonicalType binding)-    ++ maybe [] (pure . docQuotedFact "fixtures") (nominalFixtures binding)-    ++ maybe [] (pure . docQuotedFact "initial") (nominalInitial binding)+  maybe [] (pure . docHaskellSource) ((.haskell) binding)+    ++ maybe [] (pure . docQuotedFact "binding") ((.binding) binding)+    ++ maybe [] (pure . docQuotedFact "binding-version") ((.bindingVersion) binding)+    ++ maybe [] (pure . docQuotedFact "canonical-type") ((.canonicalType) binding)+    ++ maybe [] (pure . docQuotedFact "fixtures") ((.fixtures) binding)+    ++ maybe [] (pure . docQuotedFact "initial") ((.initial) binding)  docShapeKind :: MappedShape -> Doc ann docShapeKind (ShapeRecord _ _ _) = "record"@@ -163,9 +163,9 @@ docHaskellSource :: HaskellSource -> Doc ann docHaskellSource source =   "haskell"-    <+> ("package=" <> pretty (hsPackage source))-    <+> ("module=" <> pretty (hsModule source))-    <+> ("type=" <> pretty (hsType source))+    <+> ("package=" <> pretty ((.package) source))+    <+> ("module=" <> pretty ((.moduleName) source))+    <+> ("type=" <> pretty ((.valueType) source))  docQuotedFact :: Doc ann -> Text -> Doc ann docQuotedFact label value = label <+> "=" <+> dquoted value@@ -185,9 +185,9 @@ docMappedShape (ShapeUnion encoding arms) =   vsep $     [ "wire tagged-object"-        <+> ("tag=" <> dquoted (ueTagField encoding))-        <+> ("contents=" <> dquoted (ueContentsField encoding))-        <+> ("unknown-fields=" <> docUnknownFields (ueUnknownFields encoding))+        <+> ("tag=" <> dquoted ((.tagField) encoding))+        <+> ("contents=" <> dquoted ((.contentsField) encoding))+        <+> ("unknown-fields=" <> docUnknownFields ((.unknownFields) encoding))         <+> "{"     ]       ++ map (indent 2 . docWireArm) arms@@ -199,13 +199,13 @@  docWireField :: WireField -> Doc ann docWireField field =-  pretty (wfHaskell field)+  pretty ((.haskell) field)     <+> "as"-    <+> dquoted (wfKey field)+    <+> dquoted ((.key) field)     <+> ":"-    <+> docTypeExpr (wfType field)-    <+> docPresence (wfPresence field)-    <> maybe mempty (\value -> " on-missing=" <> docOnMissing value) (wfOnMissing field)+    <+> docTypeExpr ((.valueType) field)+    <+> docPresence ((.presence) field)+    <> maybe mempty (\value -> " on-missing=" <> docOnMissing value) ((.onMissing) field)  docPresence :: Presence -> Doc ann docPresence PRequired = "required"@@ -222,14 +222,14 @@ docOnMissing (OmCtor constructor) = pretty constructor  docWireEnum :: WireEnum -> Doc ann-docWireEnum entry = pretty (weCtor entry) <+> "as" <+> dquoted (weTag entry)+docWireEnum entry = pretty ((.ctor) entry) <+> "as" <+> dquoted ((.tag) entry)  docWireArm :: WireArm -> Doc ann docWireArm arm =-  pretty (waCtor arm)+  pretty ((.ctor) arm)     <+> "as"-    <+> dquoted (waTag arm)-    <> maybe mempty (\payload -> " : " <> docTypeExpr payload) (waPayload arm)+    <+> dquoted ((.tag) arm)+    <> maybe mempty (\payload -> " : " <> docTypeExpr payload) ((.payload) arm)  docTypeExpr :: TypeExpr -> Doc ann docTypeExpr TText = "Text"@@ -272,16 +272,16 @@ docWorkflow :: WorkflowNode -> Doc ann docWorkflow w =   vsep $-    [ "workflow" <+> pretty (wfId w),-      indent 2 ("name" <+> dquoted (wfStable w)),-      indent 2 ("in" <+> pretty (wfInput w) <> inFieldsDoc),-      indent 2 ("out" <+> pretty (wfOutput w)),-      indent 2 ("id from input" <> maybe mempty (\f -> "." <> pretty f) (wfIdField w) <+> "via" <+> pretty (wfIdVia w)),+    [ "workflow" <+> pretty ((.id) w),+      indent 2 ("name" <+> dquoted ((.stable) w)),+      indent 2 ("in" <+> pretty ((.input) w) <> inFieldsDoc),+      indent 2 ("out" <+> pretty ((.output) w)),+      indent 2 ("id from input" <> maybe mempty (\f -> "." <> pretty f) ((.idField) w) <+> "via" <+> pretty ((.idVia) w)),       indent 2 "body"     ]-      ++ map (indent 4 . bodyItem) (wfBody w)+      ++ map (indent 4 . bodyItem) ((.body) w)   where-    inFieldsDoc = case wfInputFields w of+    inFieldsDoc = case (.inputFields) w of       [] -> mempty       fs -> " " <> braced (map docField fs)     bodyItem (WfStep l r _) = "step" <+> pretty l <+> "->" <+> pretty r@@ -294,7 +294,7 @@  docOperation :: OperationNode -> Doc ann docOperation o =-  vsep $ ["operation" <+> pretty (opName o)] ++ map (indent 2) (shapeLines (opShape o))+  vsep $ ["operation" <+> pretty ((.name) o)] ++ map (indent 2) (shapeLines ((.shape) o))   where     shapeLines (CommandOp agg sf sv proj) =       [ "command on" <+> pretty agg,@@ -321,52 +321,52 @@ docWorkqueue :: WorkqueueNode -> Doc ann docWorkqueue w =   vsep $-    [ "workqueue" <+> pretty (wqName w) <+> "{",-      indent 2 ("queue logical =" <+> dquoted (wqLogical w)),-      indent 2 ("derive physical =" <+> dquoted (wqPhysical w)),-      indent 4 ("dlq =" <+> dquoted (wqDlq w)),-      indent 4 ("table =" <+> dquoted (wqTable w))+    [ "workqueue" <+> pretty ((.name) w) <+> "{",+      indent 2 ("queue logical =" <+> dquoted ((.logical) w)),+      indent 2 ("derive physical =" <+> dquoted ((.physical) w)),+      indent 4 ("dlq =" <+> dquoted ((.dlq) w)),+      indent 4 ("table =" <+> dquoted ((.table) w))     ]       ++ orderingLines       ++ groupKeyLines       ++ provisionLines-      ++ [indent 2 ("payload" <+> pretty (wqPayloadName w) <+> "{")]-      ++ map (indent 4 . field) (wqPayload w)+      ++ [indent 2 ("payload" <+> pretty ((.payloadName) w) <+> "{")]+      ++ map (indent 4 . field) ((.payload) w)       ++ [ indent 2 "}",-           indent 2 ("retry maxRetries =" <+> pretty (wqMaxRetries w) <+> "delay =" <+> pretty (wqDelay w) <+> "dlq =" <+> (if wqDlqOn w then "on" else "off")),+           indent 2 ("retry maxRetries =" <+> pretty ((.maxRetries) w) <+> "delay =" <+> pretty ((.delay) w) <+> "dlq =" <+> (if (.dlqOn) w then "on" else "off")),            indent 2 "disposition {"          ]-      ++ map (indent 4 . dispRow) (wqDisposition w)+      ++ map (indent 4 . dispRow) ((.disposition) w)       ++ [indent 2 "}", "}"]   where-    orderingLines = case wqOrdering w of+    orderingLines = case (.ordering) w of       WqUnordered -> []       WqFifoThroughput -> [indent 2 "ordering fifo-throughput"]       WqFifoRoundRobin -> [indent 2 "ordering fifo-roundrobin"]-    groupKeyLines = case wqGroupKey w of+    groupKeyLines = case (.groupKey) w of       Nothing -> []       Just groupKey ->         [ indent 2 $             "group key from"-              <+> pretty (gkField groupKey)+              <+> pretty ((.field) groupKey)               <+> "via"-              <+> pretty (gkVia groupKey)-              <> maybe mempty (\fixture -> " fixture " <> dquoted fixture) (gkFixture groupKey)+              <+> pretty ((.via) groupKey)+              <> maybe mempty (\fixture -> " fixture " <> dquoted fixture) ((.fixture) groupKey)         ]-    provisionLines = case wqProvision w of+    provisionLines = case (.provision) w of       WqStandard -> []       WqUnlogged -> [indent 2 "provision unlogged"]       WqPartitioned interval retention ->         [indent 2 ("provision partitioned(interval=" <> dquoted interval <> ", retention=" <> dquoted retention <> ")")]     -- Always rendered: every payload field is required, and stating it keeps     -- the canonical form self-describing.-    field f = pretty (wqfName f) <+> "->" <+> dquoted (wqfWire f) <+> docQueuePayloadType (wqfType f) <> " required"+    field f = pretty ((.name) f) <+> "->" <+> dquoted ((.wire) f) <+> docQueuePayloadType ((.valueType) f) <> " required"     docQueuePayloadType (LegacyQueueScalar QueueText) = "text"     docQueuePayloadType (LegacyQueueScalar QueueInt) = "int"     docQueuePayloadType (LegacyQueueScalar QueueBool) = "bool"     docQueuePayloadType (LegacyQueueScalar (QueueOther name)) = pretty name     docQueuePayloadType (TypedQueueExpression expression) = ":" <+> docTypeExpr expression-    dispRow r = pretty (wqdOutcome r) <+> "->" <+> act (wqdAction r)+    dispRow r = pretty ((.outcome) r) <+> "->" <+> act ((.action) r)     act IAckOk = "ackOk"     act (IRetry win) = "retry" <+> pretty win     act (IDeadLetter Nothing) = "deadLetter"@@ -375,56 +375,56 @@ docPgmqDispatch :: PgmqDispatchNode -> Doc ann docPgmqDispatch d =   vsep-    [ "dispatch" <+> pretty (pdName d) <+> "{",-      indent 2 ("source readModel =" <+> pretty (pdSourceReadModel d) <+> "key =" <+> pretty (pdSourceKey d)),-      indent 2 ("fanout body =" <+> pretty (pdFanoutBody d)),-      indent 2 ("dedup key =" <+> pretty (pdDedupKey d)),-      indent 4 ("seenIn readModel =" <+> pretty (pdDedupReadModel d) <+> "field =" <+> pretty (pdDedupReadModelField d)),-      indent 4 ("seenIn queue =" <+> pretty (pdDedupQueue d) <+> "field =" <+> pretty (pdDedupQueueField d)),-      indent 2 ("enqueue to =" <+> pretty (pdEnqueueTo d)),+    [ "dispatch" <+> pretty ((.name) d) <+> "{",+      indent 2 ("source readModel =" <+> pretty ((.sourceReadModel) d) <+> "key =" <+> pretty ((.sourceKey) d)),+      indent 2 ("fanout body =" <+> pretty ((.fanoutBody) d)),+      indent 2 ("dedup key =" <+> pretty ((.dedupKey) d)),+      indent 4 ("seenIn readModel =" <+> pretty ((.dedupReadModel) d) <+> "field =" <+> pretty ((.dedupReadModelField) d)),+      indent 4 ("seenIn queue =" <+> pretty ((.dedupQueue) d) <+> "field =" <+> pretty ((.dedupQueueField) d)),+      indent 2 ("enqueue to =" <+> pretty ((.enqueueTo) d)),       "}"     ]  docReadModel :: ReadModelNode -> Doc ann docReadModel readModel =   vsep $-    ["readmodel" <+> pretty (rmName readModel) <+> "{"]-      ++ ( if not (T.null (rmTable readModel)) || not (T.null (rmSchema readModel))+    ["readmodel" <+> pretty ((.name) readModel) <+> "{"]+      ++ ( if not (T.null ((.table) readModel)) || not (T.null ((.schema) readModel))              then-               [ indent 2 ("table =" <+> dquoted (rmTable readModel)),-                 indent 2 ("schema =" <+> dquoted (rmSchema readModel))+               [ indent 2 ("table =" <+> dquoted ((.table) readModel)),+                 indent 2 ("schema =" <+> dquoted ((.schema) readModel))                ]              else []          )       ++ [indent 2 "columns {"]-      ++ map (indent 4 . docColumn) (rmColumns readModel)+      ++ map (indent 4 . docColumn) ((.columns) readModel)       ++ [indent 2 "}"]-      ++ maybe [] docQueryTypes (queryTypes readModel)-      ++ [ indent 2 ("version =" <+> pretty (rmVersion readModel)),-           indent 2 ("shape =" <+> dquoted (rmShape readModel))+      ++ maybe [] docQueryTypes ((.queryTypes) readModel)+      ++ [ indent 2 ("version =" <+> pretty ((.version) readModel)),+           indent 2 ("shape =" <+> dquoted ((.shape) readModel))          ]       ++ policyLines-      ++ maybe [] (pure . indent 2 . ("group =" <+>) . pretty) (rmGroup readModel)-      ++ [indent 2 ("targets =" <+> bracketed (map pretty (rmObservedTargets readModel))) | rmGroup readModel /= Nothing]-      ++ maybe [] (pure . indent 2 . ("backing =" <+>) . pretty) (rmBackingTarget readModel)+      ++ maybe [] (pure . indent 2 . ("group =" <+>) . pretty) ((.group) readModel)+      ++ [indent 2 ("targets =" <+> bracketed (map pretty ((.observedTargets) readModel))) | (.group) readModel /= Nothing]+      ++ maybe [] (pure . indent 2 . ("backing =" <+>) . pretty) ((.backingTarget) readModel)       ++ ["}"]   where     docColumn columnDecl =-      pretty (rmcName columnDecl)-        <+> pretty (rmcType columnDecl)-        <> if rmcRequired columnDecl then " required" else mempty+      pretty ((.rmcName) columnDecl)+        <+> pretty ((.rmcType) columnDecl)+        <> if (.rmcRequired) columnDecl then " required" else mempty     docScope RmEntireLog = "entire-log"     docScope (RmCategory categoryName) = "category" <+> dquoted categoryName     docFeed RmInline = "inline"     docFeed RmSubscription = "subscription"-    policyLines = case rmSupply readModel of+    policyLines = case (.supply) readModel of       LegacyReadModelSupply {legacyConsistency, legacyScope, legacyFeed, legacySubscription} ->         [indent 2 ("consistency =" <+> docConsistency legacyConsistency)]           ++ maybe [] (pure . indent 2 . ("scope =" <+>) . docScope) legacyScope           ++ [indent 2 ("feed =" <+> docFeed legacyFeed)]           ++ maybe [] (pure . indent 2 . ("subscription =" <+>) . dquoted) legacySubscription       OwnerDerivedSupply ->-        [indent 2 ("freshness =" <+> docFreshness (rmFreshness readModel))]+        [indent 2 ("freshness =" <+> docFreshness ((.freshness) readModel))]     docFreshness FreshnessImmediate = "immediate"     docFreshness (FreshnessWaitForHead scope) = "wait-for-head" <+> docScope scope     docQueryTypes ReadModelQueryTypes {input, result} =@@ -435,82 +435,82 @@ docProjectionTarget :: ProjectionTargetNode -> Doc ann docProjectionTarget target =   vsep $-    [ "target" <+> pretty (ptName target) <+> "{",-      indent 2 ("schema =" <+> dquoted (ptSchema target)),-      indent 2 ("table =" <+> dquoted (ptTable target)),-      indent 2 ("reset =" <+> case ptReset target of TargetClear -> "clear"; TargetPreserve -> "preserve")+    [ "target" <+> pretty ((.name) target) <+> "{",+      indent 2 ("schema =" <+> dquoted ((.schema) target)),+      indent 2 ("table =" <+> dquoted ((.table) target)),+      indent 2 ("reset =" <+> case (.reset) target of TargetClear -> "clear"; TargetPreserve -> "preserve")     ]-      ++ [indent 2 ("depends-on =" <+> bracketed (map pretty (ptDependsOn target))) | not (null (ptDependsOn target))]+      ++ [indent 2 ("depends-on =" <+> bracketed (map pretty ((.dependsOn) target))) | not (null ((.dependsOn) target))]       ++ ["}"]  docRebuildGroup :: RebuildGroupNode -> Doc ann docRebuildGroup groupNode =   vsep-    [ "rebuild-group" <+> pretty (rgName groupNode) <+> "{",-      indent 2 ("targets =" <+> bracketed (map pretty (rgTargets groupNode))),-      indent 2 ("order =" <+> bracketed (map pretty (rgOrder groupNode))),+    [ "rebuild-group" <+> pretty ((.name) groupNode) <+> "{",+      indent 2 ("targets =" <+> bracketed (map pretty ((.targets) groupNode))),+      indent 2 ("order =" <+> bracketed (map pretty ((.order) groupNode))),       "}"     ]  docProjectionRevision :: ProjectionRevisionNode -> Doc ann docProjectionRevision revision =   vsep $-    [ "projection-revision" <+> pretty (prvName revision) <+> "{",-      indent 2 ("group =" <+> pretty (prvGroup revision))+    [ "projection-revision" <+> pretty ((.name) revision) <+> "{",+      indent 2 ("group =" <+> pretty ((.group) revision))     ]-      <> concatMap (pure . indent 2 . docRevisionTarget) (prvTargets revision)+      <> concatMap (pure . indent 2 . docRevisionTarget) ((.targets) revision)       <> ["}"]   where     docRevisionTarget target =       vsep $-        [ "target" <+> pretty (prtTarget target) <+> "{",-          indent 2 ("schema-version =" <+> dquoted (prtSchemaVersion target)),-          indent 2 ("provisioner =" <+> dquoted (prtProvisioner target)),-          indent 2 ("provisioner-version =" <+> pretty (prtProvisionerVersion target)),-          indent 2 ("expected-shape =" <+> dquoted (prtExpectedShape target)),-          indent 2 ("validator =" <+> dquoted (prtValidator target)),-          indent 2 ("validator-version =" <+> pretty (prtValidatorVersion target))+        [ "target" <+> pretty ((.target) target) <+> "{",+          indent 2 ("schema-version =" <+> dquoted ((.schemaVersion) target)),+          indent 2 ("provisioner =" <+> dquoted ((.provisioner) target)),+          indent 2 ("provisioner-version =" <+> pretty ((.provisionerVersion) target)),+          indent 2 ("expected-shape =" <+> dquoted ((.expectedShape) target)),+          indent 2 ("validator =" <+> dquoted ((.validator) target)),+          indent 2 ("validator-version =" <+> pretty ((.validatorVersion) target))         ]-          <> map (indent 2 . docPromotionObject) (prtPromotionObjects target)+          <> map (indent 2 . docPromotionObject) ((.promotionObjects) target)           <> ["}"]     docPromotionObject promotionObject =       "promotion"-        <+> ( case rpoKind promotionObject of+        <+> ( case (.kind) promotionObject of                 PromotionIndexNode -> "index"                 PromotionConstraintNode -> "constraint"                 PromotionOwnedSequenceNode -> "owned-sequence"             )-        <+> dquoted (rpoGenerationName promotionObject)+        <+> dquoted ((.generationName) promotionObject)         <+> "->"-        <+> dquoted (rpoCanonicalName promotionObject)+        <+> dquoted ((.canonicalName) promotionObject)  docExternalRead :: ExternalReadNode -> Doc ann docExternalRead externalRead =   vsep-    [ "external-read" <+> pretty (erName externalRead) <+> "{",-      indent 2 ("version =" <+> pretty (erVersion externalRead)),-      indent 2 ("query =" <+> pretty (erQueryModel externalRead)),-      indent 2 ("result-schema =" <+> dquoted (erResultSchema externalRead)),-      indent 2 ("result-type =" <+> dquoted (erResultType externalRead)),-      indent 2 ("compatible-revisions =" <+> bracketed (map pretty (erCompatibleRevisions externalRead))),-      indent 2 ("surface-generation =" <+> pretty (erSurfaceGeneration externalRead)),+    [ "external-read" <+> pretty ((.name) externalRead) <+> "{",+      indent 2 ("version =" <+> pretty ((.version) externalRead)),+      indent 2 ("query =" <+> pretty ((.queryModel) externalRead)),+      indent 2 ("result-schema =" <+> dquoted ((.resultSchema) externalRead)),+      indent 2 ("result-type =" <+> dquoted ((.resultType) externalRead)),+      indent 2 ("compatible-revisions =" <+> bracketed (map pretty ((.compatibleRevisions) externalRead))),+      indent 2 ("surface-generation =" <+> pretty ((.surfaceGeneration) externalRead)),       "}"     ]  docProjectionOwner :: ProjectionOwnerNode -> Doc ann docProjectionOwner owner =   vsep $-    ["projection-owner" <+> pretty (poName owner) <+> "{"]-      ++ map (indent 2 . ("source =" <+>) . docSource) (poSources owner)-      ++ [ indent 2 ("delivery =" <+> case poDelivery owner of DeliveryInline -> "inline"; DeliverySubscription -> "subscription"),-           indent 2 ("group =" <+> pretty (poGroup owner)),-           indent 2 ("targets =" <+> bracketed (map pretty (poTargets owner))),-           indent 2 ("order =" <+> pretty (poOrder owner))+    ["projection-owner" <+> pretty ((.name) owner) <+> "{"]+      ++ map (indent 2 . ("source =" <+>) . docSource) ((.sources) owner)+      ++ [ indent 2 ("delivery =" <+> case (.delivery) owner of DeliveryInline -> "inline"; DeliverySubscription -> "subscription"),+           indent 2 ("group =" <+> pretty ((.group) owner)),+           indent 2 ("targets =" <+> bracketed (map pretty ((.targets) owner))),+           indent 2 ("order =" <+> pretty ((.order) owner))          ]-      ++ maybe [] (pure . indent 2 . ("subscription =" <+>) . dquoted) (poSubscription owner)-      ++ maybe [] (pure . indent 2 . ("dedup =" <+>) . dquoted) (poDedup owner)-      ++ map (indent 2 . ("checkpoint-on-missing =" <+>) . docCheckpointOnMissing) (poCheckpointOnMissing owner)-      ++ [indent 2 ("replay =" <+> docReplay (poReplay owner)), "}"]+      ++ maybe [] (pure . indent 2 . ("subscription =" <+>) . dquoted) ((.subscription) owner)+      ++ maybe [] (pure . indent 2 . ("dedup =" <+>) . dquoted) ((.dedup) owner)+      ++ map (indent 2 . ("checkpoint-on-missing =" <+>) . docCheckpointOnMissing) ((.checkpointOnMissing) owner)+      ++ [indent 2 ("replay =" <+> docReplay ((.replay) owner)), "}"]   where     docSource (CatalogAggregate aggregateName) = "aggregate" <+> pretty aggregateName     docSource (CatalogCategory categoryName) = "category" <+> dquoted categoryName@@ -524,61 +524,61 @@ docEmit :: EmitNode -> Doc ann docEmit e =   vsep $-    [ "emit" <+> pretty (emName e) <+> "{",-      indent 2 ("contract" <+> pretty (emContract e)),-      indent 2 ("topic" <+> pretty (emTopic e)),-      indent 2 ("source" <+> dquoted (emSource e)),-      indent 2 ("key" <+> pretty (emKey e)),-      indent 2 ("map" <+> pretty (emDiscriminant e) <+> "{")+    [ "emit" <+> pretty ((.name) e) <+> "{",+      indent 2 ("contract" <+> pretty ((.contract) e)),+      indent 2 ("topic" <+> pretty ((.topic) e)),+      indent 2 ("source" <+> dquoted ((.source) e)),+      indent 2 ("key" <+> pretty ((.key) e)),+      indent 2 ("map" <+> pretty ((.discriminant) e) <+> "{")     ]-      ++ map (indent 4 . row) (emMap e)-      ++ [indent 4 "_ => skip" | emSkip e]+      ++ map (indent 4 . row) ((.map) e)+      ++ [indent 4 "_ => skip" | (.skip) e]       ++ [ indent 2 "}",-           indent 2 ("messageId" <+> docDerive (emMessageId e)),-           indent 2 ("idempotencyKey" <+> docDerive (emIdempotencyKey e)),+           indent 2 ("messageId" <+> docDerive ((.messageId) e)),+           indent 2 ("idempotencyKey" <+> docDerive ((.idempotencyKey) e)),            "}"          ]   where-    row r = dquoted (emrValue r) <+> "=>" <+> pretty (emrEvent r)-    docDerive d = "derive" <> maybe mempty (\p -> " " <> dquoted p) (dsPrefix d) <+> "hole"+    row r = dquoted ((.value) r) <+> "=>" <+> pretty ((.event) r)+    docDerive d = "derive" <> maybe mempty (\p -> " " <> dquoted p) ((.dsPrefix) d) <+> "hole"  docPublisher :: PublisherNode -> Doc ann docPublisher p =   vsep-    [ "publisher" <+> pretty (pubName p) <+> "{",-      indent 2 ("emit" <+> pretty (pubEmit p)),-      indent 2 ("ordering" <+> pretty (pubOrdering p)),-      indent 2 ("maxAttempts" <+> pretty (pubMaxAttempts p)),-      indent 2 (docBackoff (pubBackoff p)),-      indent 2 ("outboxId stable from" <+> pretty (pubOutboxField p)),+    [ "publisher" <+> pretty ((.name) p) <+> "{",+      indent 2 ("emit" <+> pretty ((.emit) p)),+      indent 2 ("ordering" <+> pretty ((.ordering) p)),+      indent 2 ("maxAttempts" <+> pretty ((.maxAttempts) p)),+      indent 2 (docBackoff ((.backoff) p)),+      indent 2 ("outboxId stable from" <+> pretty ((.outboxField) p)),       "}"     ]  docIntake :: IntakeNode -> Doc ann docIntake i =   vsep $-    [ "intake" <+> pretty (inkName i) <+> "{",-      indent 2 ("contract" <+> pretty (inkContract i)),-      indent 2 ("topic" <+> pretty (inkTopic i)),-      indent 2 ("accept" <+> hsep (map pretty (inkAccept i)))+    [ "intake" <+> pretty ((.name) i) <+> "{",+      indent 2 ("contract" <+> pretty ((.contract) i)),+      indent 2 ("topic" <+> pretty ((.topic) i)),+      indent 2 ("accept" <+> hsep (map pretty ((.accept) i)))     ]-      ++ map (indent 2 . docBind) (inkBinds i)-      ++ [ indent 2 ("dedupe key" <+> pretty (inkDedupeKey i) <+> "policy" <+> pretty (inkDedupePolicy i))+      ++ map (indent 2 . docBind) ((.binds) i)+      ++ [ indent 2 ("dedupe key" <+> pretty ((.dedupeKey) i) <+> "policy" <+> pretty ((.dedupePolicy) i))          ]-      ++ [indent 2 "persist = dedupe-only" | inkPersist i == InkPersistDedupeOnly]-      ++ [ indent 2 (docDecode (inkDecode i)),+      ++ [indent 2 "persist = dedupe-only" | (.persist) i == InkPersistDedupeOnly]+      ++ [ indent 2 (docDecode ((.decode) i)),            indent 2 "disposition {"          ]-      ++ map (indent 4 . docDispRow) (inkDisposition i)+      ++ map (indent 4 . docDispRow) ((.disposition) i)       ++ [indent 2 "}", "}"]   where     docBind b =       "bind"-        <+> pretty (brField b)+        <+> pretty ((.field) b)         <+> "from"-        <+> docSource (brSource b)-        <> (if brRequired b then " required" else mempty)-        <> (if brCrossCheck b then " cross-check body" else mempty)+        <+> docSource ((.source) b)+        <> (if (.required) b then " required" else mempty)+        <> (if (.crossCheck) b then " cross-check body" else mempty)     docSource (SrcHeader h) = "header" <+> dquoted h     docSource SrcBody = "body"     docSource SrcKafkaKey = "kafka-key"@@ -586,11 +586,11 @@     docDecode d =       vsep         [ "decode {",-          indent 2 ("envelope" <+> pretty (decEnvelope d)),-          indent 2 ("body" <+> (if decBodyStrict d then "strict" else "lenient") <+> "schemaVersion ==" <+> pretty (decBodySchemaVersion d)),+          indent 2 ("envelope" <+> pretty ((.envelope) d)),+          indent 2 ("body" <+> (if (.bodyStrict) d then "strict" else "lenient") <+> "schemaVersion ==" <+> pretty ((.bodySchemaVersion) d)),           "}"         ]-    docDispRow r = pretty (drOutcome r) <+> "=>" <+> docAction (drAction r)+    docDispRow r = pretty ((.outcome) r) <+> "=>" <+> docAction ((.action) r)     docAction IAckOk = "ackOk"     docAction (IRetry w) = "retry" <+> pretty w     docAction (IDeadLetter Nothing) = "deadLetter"@@ -603,28 +603,28 @@ docContract :: ContractNode -> Doc ann docContract c =   vsep $-    [ "contract" <+> pretty (ctrName c) <+> "{",-      indent 2 ("schemaVersion" <+> pretty (ctrSchemaVersion c)),-      indent 2 ("discriminator" <+> pretty (ctrDiscriminator c))+    [ "contract" <+> pretty ((.name) c) <+> "{",+      indent 2 ("schemaVersion" <+> pretty ((.schemaVersion) c)),+      indent 2 ("discriminator" <+> pretty ((.discriminator) c))     ]-      ++ map (indent 2 . docTopic) (ctrTopics c)-      ++ map (indent 2 . docContractEvent) (ctrEvents c)+      ++ map (indent 2 . docTopic) ((.topics) c)+      ++ map (indent 2 . docContractEvent) ((.events) c)       ++ ["}"]   where     docTopic (alias, t) = "topic" <+> pretty alias <+> dquoted t     docContractEvent e =       vsep $-        ["event" <+> pretty (ceName e) <+> "on" <+> pretty (ceTopic e) <+> "{"]-          ++ map (indent 2 . docContractField) (ceFields e)+        ["event" <+> pretty ((.name) e) <+> "on" <+> pretty ((.topic) e) <+> "{"]+          ++ map (indent 2 . docContractField) ((.fields) e)           ++ ["}"]     docContractField f =       hsep-        ( [pretty (cfName f)]-            ++ maybe [] (\selector -> ["haskell", pretty selector]) (cfSelector f)-            ++ maybe [] (\wireKey -> ["as", dquoted wireKey]) (cfWireKey f)+        ( [pretty ((.name) f)]+            ++ maybe [] (\selector -> ["haskell", pretty selector]) ((.selector) f)+            ++ maybe [] (\wireKey -> ["as", dquoted wireKey]) ((.wireKey) f)         )         <> ":"-        <+> docContractType (cfType f)+        <+> docContractType ((.valueType) f)     docContractType (CTypeId p) = "typeid" <+> dquoted p     docContractType CText = "text"     docContractType CInt = "int"@@ -636,74 +636,74 @@ docProcess :: ProcessNode -> Doc ann docProcess p =   vsep-    [ "process" <+> pretty (procId p),-      indent 2 ("name" <+> dquoted (procName p)),-      indent 2 (docInput (procInput p)),-      indent 2 (docCorrelate (procCorrelate p)),-      indent 2 (docSaga (procSaga p)),-      indent 2 ("target" <+> pretty (procTarget p)),-      indent 2 ("projections" <+> bracketed (map pretty (procProjections p))),+    [ "process" <+> pretty ((.id) p),+      indent 2 ("name" <+> dquoted ((.name) p)),+      indent 2 (docInput ((.input) p)),+      indent 2 (docCorrelate ((.correlate) p)),+      indent 2 (docSaga ((.saga) p)),+      indent 2 ("target" <+> pretty ((.target) p)),+      indent 2 ("projections" <+> bracketed (map pretty ((.projections) p))),       mempty,-      indent 2 (docHandle (procHandle p)),+      indent 2 (docHandle ((.handle) p)),       mempty,       indent 2 "dispatch-id strategy=uuidv5 from=(name, correlationId, sourceEventId, emitIndex)",-      indent 2 ("rejected =>" <+> docPolicyChoice (procRejected p)),-      indent 2 ("poison =>" <+> docPolicyChoice (procPoison p)),+      indent 2 ("rejected =>" <+> docPolicyChoice ((.rejected) p)),+      indent 2 ("poison =>" <+> docPolicyChoice ((.poison) p)),       mempty,-      indent 2 (docTimer (procTimer p))+      indent 2 (docTimer ((.timer) p))     ]  docRouter :: RouterNode -> Doc ann docRouter r =   vsep-    [ "router" <+> pretty (rtId r),-      indent 2 ("name" <+> dquoted (rtName r)),-      indent 2 (docInput (rtInput r)),-      indent 2 (docRouterKey (isDeclarativeResolve (rtResolve r)) (rtKey r)),-      indent 2 (docResolve (rtResolve r)),-      indent 2 ("target" <+> pretty (rtTarget r)),-      indent 2 ("projections" <+> bracketed (map pretty (rtProjections r))),-      indent 2 (docRouterDispatch (rtDispatch r)),+    [ "router" <+> pretty ((.id) r),+      indent 2 ("name" <+> dquoted ((.name) r)),+      indent 2 (docInput ((.input) r)),+      indent 2 (docRouterKey (isDeclarativeResolve ((.resolve) r)) ((.key) r)),+      indent 2 (docResolve ((.resolve) r)),+      indent 2 ("target" <+> pretty ((.target) r)),+      indent 2 ("projections" <+> bracketed (map pretty ((.projections) r))),+      indent 2 (docRouterDispatch ((.dispatch) r)),       indent 2 "dispatch-id strategy=uuidv5 from=(name, key, sourceEventId, targetStreamName, occurrence)",-      indent 2 ("rejected =>" <+> docPolicyChoice (rtRejected r)),-      indent 2 ("poison =>" <+> docPolicyChoice (rtPoison r))+      indent 2 ("rejected =>" <+> docPolicyChoice ((.rejected) r)),+      indent 2 ("poison =>" <+> docPolicyChoice ((.poison) r))     ]  docRouterKey :: Bool -> CorrelateDecl -> Doc ann docRouterKey declarative key-  | declarative = "key" <+> ("input." <> pretty (corrField key))-  | otherwise = "key" <+> ("input." <> pretty (corrField key)) <+> "via" <+> pretty (corrVia key)+  | declarative = "key" <+> ("input." <> pretty ((.field) key))+  | otherwise = "key" <+> ("input." <> pretty ((.field) key)) <+> "via" <+> pretty ((.via) key)  isDeclarativeResolve :: ResolveDecl -> Bool-isDeclarativeResolve resolve = case rvSource resolve of+isDeclarativeResolve resolve = case (.source) resolve of   ResolveDeclarative {} -> True   _ -> False  docResolve :: ResolveDecl -> Doc ann-docResolve resolve = case rvSource resolve of+docResolve resolve = case (.source) resolve of   ResolveReadModel name -> custom ("read-model" <+> pretty name)   ResolveHole -> custom "hole"   ResolveDeclarative selection ->     vsep       ( [ "resolve declarative {",-          indent 2 ("identity =" <+> dquoted (rsIdentity selection)),-          indent 2 ("version =" <+> pretty (rsVersion selection)),-          indent 2 ("query = read-model" <+> pretty (rsQuery selection) <+> "with" <+> pretty (rsQueryInput selection)),-          indent 2 ("where =" <+> docExpr 0 (rsPredicate selection)),-          indent 2 ("recipient =" <+> docExpr 0 (rsRecipient selection)),-          indent 2 ("order =" <+> pretty (rsOrder selection)),-          indent 2 ("dedupe =" <+> pretty (rsDedupe selection))+          indent 2 ("identity =" <+> dquoted ((.identity) selection)),+          indent 2 ("version =" <+> pretty ((.version) selection)),+          indent 2 ("query = read-model" <+> pretty ((.query) selection) <+> "with" <+> pretty ((.queryInput) selection)),+          indent 2 ("where =" <+> docExpr 0 ((.predicate) selection)),+          indent 2 ("recipient =" <+> docExpr 0 ((.recipient) selection)),+          indent 2 ("order =" <+> pretty ((.order) selection)),+          indent 2 ("dedupe =" <+> pretty ((.dedupe) selection))         ]-          ++ maybe [] (\(recipientLimit, _) -> [indent 2 ("max-recipients =" <+> pretty recipientLimit)]) (rsLimit selection)-          ++ [ indent 2 ("empty =>" <+> docSelectionDisposition (rsEmptyPolicy selection)),-               indent 2 ("failure =>" <+> docSelectionDisposition (rsFailurePolicy selection)),-               indent 2 ("redelivery =" <+> pretty (rsRedelivery selection)),-               indent 2 ("partial =" <+> pretty (rsPartial selection)),+          ++ maybe [] (\(recipientLimit, _) -> [indent 2 ("max-recipients =" <+> pretty recipientLimit)]) ((.limit) selection)+          ++ [ indent 2 ("empty =>" <+> docSelectionDisposition ((.emptyPolicy) selection)),+               indent 2 ("failure =>" <+> docSelectionDisposition ((.failurePolicy) selection)),+               indent 2 ("redelivery =" <+> pretty ((.redelivery) selection)),+               indent 2 ("partial =" <+> pretty ((.partial) selection)),                "}"              ]       )   where-    custom source = "resolve stable via" <+> source <+> "row" <+> braced (map pretty (rvRow resolve))+    custom source = "resolve stable via" <+> source <+> "row" <+> braced (map pretty ((.row) resolve))  docSelectionDisposition :: SelectionDispositionSyntax -> Doc ann docSelectionDisposition SelectionAck = "ack"@@ -714,8 +714,8 @@ docRouterDispatch :: RouterDispatchNode -> Doc ann docRouterDispatch dispatch =   vsep-    [ "dispatch-each" <+> pretty (rdCommand dispatch) <+> braced (map docFieldBinding (rdFields dispatch)),-      indent 2 (docDispDisposition (rdDisposition dispatch))+    [ "dispatch-each" <+> pretty ((.command) dispatch) <+> braced (map docFieldBinding ((.fields) dispatch)),+      indent 2 (docDispDisposition ((.disposition) dispatch))     ]  docPolicyChoice :: PolicyChoice -> Doc ann@@ -724,37 +724,37 @@ docPolicyChoice PolSkip = "skip"  docInput :: InputDecl -> Doc ann-docInput input = case inType input of-  Just inputType -> "input" <+> pretty (inName input) <+> ":" <+> docTypeExpr inputType-  Nothing -> "input" <+> pretty (inName input) <+> braced (map docField (inFields input))+docInput input = case (.valueType) input of+  Just inputType -> "input" <+> pretty ((.name) input) <+> ":" <+> docTypeExpr inputType+  Nothing -> "input" <+> pretty ((.name) input) <+> braced (map docField ((.fields) input))  docCorrelate :: CorrelateDecl -> Doc ann-docCorrelate c = "correlate" <+> ("input." <> pretty (corrField c)) <+> "via" <+> pretty (corrVia c)+docCorrelate c = "correlate" <+> ("input." <> pretty ((.field) c)) <+> "via" <+> pretty ((.via) c)  docSaga :: SagaRef -> Doc ann-docSaga s = "saga" <+> pretty (sagaAgg s) <+> "category" <+> dquoted (sagaCategory s)+docSaga s = "saga" <+> pretty ((.agg) s) <+> "category" <+> dquoted ((.category) s)  docHandle :: HandleNode -> Doc ann docHandle h =   vsep $-    ["on" <+> pretty (hOn h)]-      ++ [indent 2 (docAdvance (hAdvance h))]-      ++ map (indent 2 . docDispatch) (hDispatch h)-      ++ [indent 2 ("schedule" <+> pretty (hSchedule h))]+    ["on" <+> pretty ((.on) h)]+      ++ [indent 2 (docAdvance ((.advance) h))]+      ++ map (indent 2 . docDispatch) ((.dispatch) h)+      ++ [indent 2 ("schedule" <+> pretty ((.schedule) h))]  docAdvance :: AdvanceNode -> Doc ann-docAdvance a = "advance" <+> pretty (advCommand a) <+> braced (map docFieldBinding (advFields a))+docAdvance a = "advance" <+> pretty ((.advCommand) a) <+> braced (map docFieldBinding ((.advFields) a))  docDispatch :: DispatchNode -> Doc ann docDispatch d =   vsep-    [ "dispatch" <+> (pretty (dispTarget d) <> "@" <> pretty (dispKey d)) <+> pretty (dispCommand d) <+> braced (map docFieldBinding (dispFields d)),-      indent 2 (docDispDisposition (dispDisposition d))+    [ "dispatch" <+> (pretty ((.target) d) <> "@" <> pretty ((.key) d)) <+> pretty ((.command) d) <+> braced (map docFieldBinding ((.fields) d)),+      indent 2 (docDispDisposition ((.disposition) d))     ]  docDispDisposition :: DispatchDisposition -> Doc ann docDispDisposition x =-  "on-appended" <+> docDisp (onAppended x) <+> ";" <+> "on-duplicate" <+> docDisp (onDuplicate x) <+> ";" <+> "on-failed" <+> docDisp (onFailed x)+  "on-appended" <+> docDisp ((.onAppended) x) <+> ";" <+> "on-duplicate" <+> docDisp ((.onDuplicate) x) <+> ";" <+> "on-failed" <+> docDisp ((.onFailed) x)  docDisp :: Disp -> Doc ann docDisp DAckOk = "AckOk"@@ -764,54 +764,54 @@ docTimer :: TimerNode -> Doc ann docTimer t =   vsep-    [ "timer" <+> pretty (tmName t),-      indent 2 ("id" <+> docIdExpr (tmId t)),-      indent 2 ("fireAt" <+> docFireAt (tmFireAt t)),-      indent 2 ("payload" <+> braced (map docFieldBinding (tmPayload t))),-      indent 2 (docFire (tmFire t)),-      indent 2 ("decode unknown-status =>" <+> pretty (tmDecodeUnknown t)),-      indent 2 ("max-attempts" <+> pretty (tmMaxAttempts t) <+> "dead-letter" <+> dquoted (tmDeadLetter t))+    [ "timer" <+> pretty ((.name) t),+      indent 2 ("id" <+> docIdExpr ((.id) t)),+      indent 2 ("fireAt" <+> docFireAt ((.fireAt) t)),+      indent 2 ("payload" <+> braced (map docFieldBinding ((.payload) t))),+      indent 2 (docFire ((.fire) t)),+      indent 2 ("decode unknown-status =>" <+> pretty ((.decodeUnknown) t)),+      indent 2 ("max-attempts" <+> pretty ((.maxAttempts) t) <+> "dead-letter" <+> dquoted ((.deadLetter) t))     ]  docIdExpr :: IdExpr -> Doc ann-docIdExpr e = "uuidv5" <+> dquoted (idePrefix e) <+> "<>" <+> pretty (ideField e)+docIdExpr e = "uuidv5" <+> dquoted ((.prefix) e) <+> "<>" <+> pretty ((.field) e)  docFireAt :: FireAtExpr -> Doc ann-docFireAt f = ("input." <> pretty (faField f)) <+> "+" <+> pretty (faWindow f)+docFireAt f = ("input." <> pretty ((.field) f)) <+> "+" <+> pretty ((.window) f)  docFire :: FireNode -> Doc ann docFire f =   vsep-    [ "fire dispatch" <+> (pretty (fireTarget f) <> "@" <> pretty (fireKey f)) <+> pretty (fireCommand f) <+> braced (map docFieldBinding (fireFields f)),-      indent 2 ("fired-event-id" <+> docIdExpr (fireFiredEventId f)),-      indent 2 (docFireDisposition (fireDisposition f))+    [ "fire dispatch" <+> (pretty ((.target) f) <> "@" <> pretty ((.key) f)) <+> pretty ((.command) f) <+> braced (map docFieldBinding ((.fields) f)),+      indent 2 ("fired-event-id" <+> docIdExpr ((.firedEventId) f)),+      indent 2 (docFireDisposition ((.disposition) f))     ]  docFireDisposition :: FireDisposition -> Doc ann docFireDisposition x =   "on-ok"-    <+> docFireOutcome (onOk x)+    <+> docFireOutcome ((.onOk) x)     <+> ";"     <+> "on-reject"-    <+> docFireOutcome (onReject x)+    <+> docFireOutcome ((.onReject) x)     <+> ";"     <+> "on-ambiguous"-    <+> docFireOutcome (onAmbiguous x)+    <+> docFireOutcome ((.onAmbiguous) x)     <+> ";"     <+> "on-error"-    <+> docFireOutcome (onError x)+    <+> docFireOutcome ((.onError) x)     <+> ";"     <+> "not-mine"-    <+> docFireOutcome (notMine x)+    <+> docFireOutcome ((.notMine) x)  docFireOutcome :: FireOutcome -> Doc ann docFireOutcome OFired = "Fired" docFireOutcome ORetry = "Retry"  docFieldBinding :: FieldBinding -> Doc ann-docFieldBinding b = case fbValue b of-  Nothing -> pretty (fbName b)-  Just v -> pretty (fbName b) <> "=" <> docValue v+docFieldBinding b = case (.value) b of+  Nothing -> pretty ((.name) b)+  Just v -> pretty ((.name) b) <> "=" <> docValue v   where     docValue v = case T.stripPrefix "\"" v >>= T.stripSuffix "\"" of       Just rawInner -> dquoted rawInner@@ -834,43 +834,43 @@ docAggregate :: Aggregate -> Doc ann docAggregate a =   vsep $-    [ "aggregate" <+> pretty (aggName a),-      maybe mempty (indent 2 . docDomainOutcomeTypes) (aggDomainOutcomeTypes a),+    [ "aggregate" <+> pretty ((.name) a),+      maybe mempty (indent 2 . docDomainOutcomeTypes) ((.domainOutcomeTypes) a),       indent 2 "regs",-      indent 4 (vsep (map docReg (aggRegs a))),-      indent 2 ("states" <+> hsep (map docState (aggStates a))),+      indent 4 (vsep (map docReg ((.regs) a))),+      indent 2 ("states" <+> hsep (map docState ((.states) a))),       mempty     ]-      ++ map (indent 2 . docCommand) (aggCommands a)-      ++ blank (aggCommands a)-      ++ map (indent 2 . docEvent) (aggEvents a)-      ++ blank (aggEvents a)-      ++ map (indent 2 . docTransition) (aggTransitions a)-      ++ blank (aggTransitions a)-      ++ maybe [] (\w -> [indent 2 (docWire w)]) (aggWire a)-      ++ maybe [] (\p -> [indent 2 (docProjection p)]) (aggProjection a)-      ++ maybe [] (\snapshot -> [indent 2 (docSnapshot snapshot)]) (aggSnapshot a)+      ++ map (indent 2 . docCommand) ((.commands) a)+      ++ blank ((.commands) a)+      ++ map (indent 2 . docEvent) ((.events) a)+      ++ blank ((.events) a)+      ++ map (indent 2 . docTransition) ((.transitions) a)+      ++ blank ((.transitions) a)+      ++ maybe [] (\w -> [indent 2 (docWire w)]) ((.wire) a)+      ++ maybe [] (\p -> [indent 2 (docProjection p)]) ((.projection) a)+      ++ maybe [] (\snapshot -> [indent 2 (docSnapshot snapshot)]) ((.snapshot) a)   where     blank xs = if null xs then [] else [mempty]  docDomainOutcomeTypes :: DomainOutcomeTypes -> Doc ann docDomainOutcomeTypes declaration =   "domain-outcomes"-    <+> ("rejection=" <> pretty (rejectionType declaration))-    <+> ("no-op=" <> pretty (noOpType declaration))+    <+> ("rejection=" <> pretty ((.rejectionType) declaration))+    <+> ("no-op=" <> pretty ((.noOpType) declaration))  docSnapshot :: SnapshotSpec -> Doc ann docSnapshot snapshot =   vsep-    [ "snapshot" <+> policyDoc (snapPolicy snapshot),-      indent 2 ("state-codec version=" <> pretty (snapCodecVersion snapshot) <+> "shape-hash=" <> dquoted (snapShapeHash snapshot))+    [ "snapshot" <+> policyDoc ((.policy) snapshot),+      indent 2 ("state-codec version=" <> pretty ((.codecVersion) snapshot) <+> "shape-hash=" <> dquoted ((.shapeHash) snapshot))     ]   where     policyDoc (SnapEvery interval) = "every" <+> pretty interval     policyDoc SnapOnTerminal = "on-terminal"  docReg :: RegDecl -> Doc ann-docReg r = pretty (regName r) <+> docTypeExpr (regType r) <+> "=" <+> docRegInitial (regInitial r)+docReg r = pretty ((.name) r) <+> docTypeExpr ((.valueType) r) <+> "=" <+> docRegInitial ((.initial) r)  docRegInitial :: RegInitial -> Doc ann docRegInitial (RegInitBare value) = pretty value@@ -879,46 +879,46 @@ docBackoff :: BackoffSpec -> Doc ann docBackoff backoff =   "backoff"-    <+> pretty (boKind backoff)-    <+> pretty (boWindow backoff)-    <+> maybe mempty (\window -> "max=" <> pretty window) (boMax backoff)-    <+> maybe mempty (\multiplier -> "multiplier=" <> pretty multiplier) (boMultiplier backoff)+    <+> pretty ((.kind) backoff)+    <+> pretty ((.window) backoff)+    <+> maybe mempty (\window -> "max=" <> pretty window) ((.max) backoff)+    <+> maybe mempty (\multiplier -> "multiplier=" <> pretty multiplier) ((.multiplier) backoff)  docState :: StateDecl -> Doc ann-docState s = pretty (stName s) <> (if stTerminal s then "!" else mempty)+docState s = pretty ((.name) s) <> (if (.terminal) s then "!" else mempty)  docCommand :: Command -> Doc ann-docCommand c = "command" <+> pretty (cmdName c) <+> braced (map docAggregateField (cmdFields c))+docCommand c = "command" <+> pretty ((.name) c) <+> braced (map docAggregateField ((.fields) c))  docAggregateField :: AggregateField -> Doc ann docAggregateField f =   hsep-    ( [pretty (aggregateFieldName f)]-        ++ maybe [] (\selector -> ["haskell", pretty selector]) (aggregateFieldSelector f)-        ++ maybe [] (\wireKey -> ["as", dquoted wireKey]) (aggregateFieldWireKey f)+    ( [pretty ((.name) f)]+        ++ maybe [] (\selector -> ["haskell", pretty selector]) ((.selector) f)+        ++ maybe [] (\wireKey -> ["as", dquoted wireKey]) ((.wireKey) f)     )-    <> maybe mempty (\ty -> ":" <> docTypeExpr ty) (aggregateFieldType f)+    <> maybe mempty (\ty -> ":" <> docTypeExpr ty) ((.valueType) f)  docField :: Field -> Doc ann-docField f = case fieldType f of-  Nothing -> pretty (fieldName f)-  Just ty -> pretty (fieldName f) <> ":" <> pretty ty+docField f = case (.valueType) f of+  Nothing -> pretty ((.name) f)+  Just ty -> pretty ((.name) f) <> ":" <> pretty ty  docEvent :: Event -> Doc ann docEvent e =-  case evUpcastFrom e of+  case (.upcastFrom) e of     Nothing -> line1     Just (m, _) -> vsep [line1, indent 2 ("upcast from v" <> pretty m <+> "=" <+> "HOLE")]   where-    kw = case (evRetiring e, evDeprecated e) of+    kw = case ((.retiring) e, (.deprecated) e) of       (False, False) -> "event"       (True, False) -> "retiring event"       (False, True) -> "deprecated event"       (True, True) -> "retiring deprecated event"     nameVer =-      pretty (evName e)-        <> (if evVersion e > 1 then " v" <> pretty (evVersion e) else mempty)-    bodyDoc = case evBody e of+      pretty ((.name) e)+        <> (if (.version) e > 1 then " v" <> pretty ((.version) e) else mempty)+    bodyDoc = case (.body) e of       EventFromCommand cmd -> "=" <+> ("fields(" <> pretty cmd <> ")")       EventFields fs -> braced (map docAggregateField fs)     line1 = kw <+> nameVer <+> bodyDoc@@ -942,19 +942,19 @@ docTransition :: Transition -> Doc ann docTransition t =   vsep $-    [modePrefix <> pretty (tSource t) <+> "--" <+> pretty (tCommand t) <+> "-->"]+    [modePrefix <> pretty ((.source) t) <+> "--" <+> pretty ((.command) t) <+> "-->"]       ++ map (indent 2) clauses   where-    modePrefix = case tMode t of+    modePrefix = case (.mode) t of       TmLive -> mempty       TmReplayOnly -> "replay-only "     clauses =-      ["implementation hole" | tImplementation t == HoleImplementation]-        ++ maybe [] (\g -> ["guard" <+> docExpr 0 g]) (tGuard t)-        ++ map (\(r, e) -> "write" <+> pretty r <+> ":=" <+> docExpr 0 e) (tWrites t)-        ++ maybe [] (pure . docTransitionOutcome) (tOutcome t)-        ++ map (\ev -> "emit" <+> pretty ev) (tEmits t)-        ++ ["goto" <+> pretty (tGoto t)]+      ["implementation hole" | (.implementation) t == HoleImplementation]+        ++ maybe [] (\g -> ["guard" <+> docExpr 0 g]) ((.guard) t)+        ++ map (\(r, e) -> "write" <+> pretty r <+> ":=" <+> docExpr 0 e) ((.writes) t)+        ++ maybe [] (pure . docTransitionOutcome) ((.outcome) t)+        ++ map (\ev -> "emit" <+> pretty ev) ((.emits) t)+        ++ ["goto" <+> pretty ((.goto) t)]  docTransitionOutcome :: TransitionOutcome -> Doc ann docTransitionOutcome (OutcomeAccepted _) = "outcome accepted"@@ -964,21 +964,21 @@ docWire :: WireSpec -> Doc ann docWire w =   "wire"-    <+> ("kind=" <> pretty (wireKind w))-    <+> ("fields=" <> pretty (wireFields w))-    <+> ("schemaVersion=" <> pretty (wireSchemaVersion w))+    <+> ("kind=" <> pretty ((.kind) w))+    <+> ("fields=" <> pretty ((.fields) w))+    <+> ("schemaVersion=" <> pretty ((.schemaVersion) w))  docProjection :: ProjectionSpec -> Doc ann docProjection p =   vsep $     [ hsep $-        ["projection", pretty (projTable p)]-          ++ maybe [] (pure . ("consistency=" <>) . docConsistency) (projConsistency p)-          ++ ["key=" <> pretty (projKey p)]+        ["projection", pretty ((.table) p)]+          ++ maybe [] (pure . ("consistency=" <>) . docConsistency) ((.consistency) p)+          ++ ["key=" <> pretty ((.key) p)]     ]-      ++ maybe [] (\m -> [indent 2 (statusMapHead m <+> braced (map pair (mapPairs m)))]) (projStatusMap p)+      ++ maybe [] (\m -> [indent 2 (statusMapHead m <+> braced (map pair ((.pairs) m)))]) ((.statusMap) p)   where-    statusMapHead m = if mapPartial m then "status-map partial" else "status-map"+    statusMapHead m = if (.partial) m then "status-map partial" else "status-map"     pair (l, r) = pretty l <> "=>" <> pretty r  docConsistency :: Consistency -> Doc ann

src/Keiro/Dsl/ProjectionMappedImpact.hs view

@@ -96,13 +96,13 @@     derivedConsumers =       Set.fromList         [ derived-        | mappedConsumers <- Map.elems (impactDeclarationConsumers semantic),+        | mappedConsumers <- Map.elems ((.declarationConsumers) semantic),           DerivedProjectionConsumer derived <- Set.toList mappedConsumers         ]     mappedRoots =       sort . nub $         [ ProjectionMappedRoot derived declarationKey usePath-        | (declarationKey, usePathValues) <- Map.toAscList (impactUsePaths semantic),+        | (declarationKey, usePathValues) <- Map.toAscList ((.usePaths) semantic),           usePath <- usePathValues,           aggregate <- maybeToList (eventAuthority usePath),           derived <- Set.toAscList derivedConsumers,@@ -111,7 +111,7 @@     operational =       mapMaybeOperation         (Set.toAscList (Set.fromList [derived | ProjectionMappedRoot derived _ _ <- mappedRoots]))-    unsupportedSources = impactUnsupportedProjectionSources semantic+    unsupportedSources = (.unsupportedProjectionSources) semantic      mapMaybeOperation = foldr (maybe id (:) . operationFor graph spec) []     mapMaybeUnsupported = foldr (maybe id (:) . unsupportedFor spec) []@@ -125,13 +125,13 @@   Right graph -> Just (projectionMappedImpact service (semanticImpact graph))  projectionConsumersFor :: ProjectionMappedImpact -> MappedKey -> Set DerivedMappedConsumer-projectionConsumersFor impact declarationKey = Map.findWithDefault Set.empty declarationKey (consumers impact)+projectionConsumersFor impact declarationKey = Map.findWithDefault Set.empty declarationKey ((.consumers) impact)  projectionOperationsFor :: ProjectionMappedImpact -> MappedKey -> [ProjectionOperationalImpact] projectionOperationsFor impact declarationKey =   [ operation   | derived <- Set.toAscList (projectionConsumersFor impact declarationKey),-    operation <- maybeToList (Map.lookup derived (operations impact))+    operation <- maybeToList (Map.lookup derived ((.operations) impact))   ]  -- | Stable source metadata for generated aggregate codecs. Existing aggregate@@ -163,7 +163,7 @@         [ renderUsePath (UsePath site (useSiteSegments graph site))             <> "|wire="             <> wireFingerprint graph (unMappedKey declarationKey)-        | site@(RootEventField authority _ _ declarationKey) <- tgUseSites graph,+        | site@(RootEventField authority _ _ declarationKey) <- (.useSites) graph,           authority == aggregate         ] @@ -173,11 +173,11 @@ -- dependency. Category/all boundaries remain explicit and untyped. renderProjectionMappedImpact :: ProjectionMappedImpact -> [Text] renderProjectionMappedImpact impact-  | Map.null (consumers impact) && null (unsupported impact) = []+  | Map.null ((.consumers) impact) && null ((.unsupported) impact) = []   | otherwise =       ["projection mapped impact:"]-        <> concatMap renderDeclaration (Map.toAscList (consumers impact))-        <> renderUnsupported (unsupported impact)+        <> concatMap renderDeclaration (Map.toAscList ((.consumers) impact))+        <> renderUnsupported ((.unsupported) impact)   where     renderDeclaration (declarationKey, derivedConsumers) =       ["  " <> unMappedKey declarationKey]@@ -186,10 +186,10 @@       [ "    " <> mappedConsumerIdentity (DerivedProjectionConsumer derived),         "      inherited event roots: " <> renderSet (Set.fromList (pathsFor declarationKey derived))       ]-        <> maybe [] (pure . ("      operation: " <>) . renderOperation) (Map.lookup derived (operations impact))+        <> maybe [] (pure . ("      operation: " <>) . renderOperation) (Map.lookup derived ((.operations) impact))     pathsFor declarationKey derived =       [ renderUsePath inheritedPath-      | ProjectionMappedRoot candidate declaration inheritedPath <- roots impact,+      | ProjectionMappedRoot candidate declaration inheritedPath <- (.roots) impact,         candidate == derived,         declaration == declarationKey       ]@@ -236,17 +236,17 @@         { consumer = derived,           group = Nothing,           targets = Set.singleton projection,-          readModels = Set.fromList [rmName readModel | readModel <- readModelNodes spec, rmName readModel == projection],+          readModels = Set.fromList [(.name) readModel | readModel <- readModelNodes spec, (.name) readModel == projection],           replayable = False,           sourceFingerprint = projectionAggregateSourceFingerprintWithGraph graph aggregate         }   CatalogProjectionConsumer ownerName aggregate -> do-    owner <- find ((== ownerName) . poName) (projectionOwners spec)+    owner <- find ((== ownerName) . (.name)) (projectionOwners spec)     pure       ProjectionOperationalImpact         { consumer = derived,-          group = Just (poGroup owner),-          targets = Set.fromList (poTargets owner),+          group = Just ((.group) owner),+          targets = Set.fromList ((.targets) owner),           readModels = observingReadModels spec owner,           replayable = isReplayable owner,           sourceFingerprint = projectionAggregateSourceFingerprintWithGraph graph aggregate@@ -254,12 +254,12 @@  unsupportedFor :: Spec -> UnsupportedProjectionSource -> Maybe UnsupportedProjectionImpact unsupportedFor spec boundary = do-  owner <- find ((== unsupportedOwner boundary) . poName) (projectionOwners spec)+  owner <- find ((== unsupportedOwner boundary) . (.name)) (projectionOwners spec)   pure     UnsupportedProjectionImpact       { source = boundary,-        group = poGroup owner,-        targets = Set.fromList (poTargets owner),+        group = (.group) owner,+        targets = Set.fromList ((.targets) owner),         readModels = observingReadModels spec owner,         replayable = isReplayable owner       }@@ -267,14 +267,14 @@ observingReadModels :: Spec -> ProjectionOwnerNode -> Set Name observingReadModels spec owner =   Set.fromList-    [ rmName readModel+    [ (.name) readModel     | readModel <- readModelNodes spec,-      rmGroup readModel == Just (poGroup owner),-      not (Set.disjoint (Set.fromList (rmObservedTargets readModel)) (Set.fromList (poTargets owner)))+      (.group) readModel == Just ((.group) owner),+      not (Set.disjoint (Set.fromList ((.observedTargets) readModel)) (Set.fromList ((.targets) owner)))     ]  eventAuthority :: UsePath -> Maybe Name-eventAuthority UsePath {upRoot = RootEventField aggregate _ _ _} = Just aggregate+eventAuthority UsePath {root = RootEventField aggregate _ _ _} = Just aggregate eventAuthority _ = Nothing  derivedAuthority :: DerivedMappedConsumer -> Name@@ -286,13 +286,13 @@ unsupportedOwner (UnsupportedCatalogAll owner) = owner  projectionOwners :: Spec -> [ProjectionOwnerNode]-projectionOwners spec = [owner | NProjectionOwner owner <- specNodes spec]+projectionOwners spec = [owner | NProjectionOwner owner <- (.nodes) spec]  readModelNodes :: Spec -> [ReadModelNode]-readModelNodes spec = [readModel | NReadModel readModel <- specNodes spec]+readModelNodes spec = [readModel | NReadModel readModel <- (.nodes) spec]  isReplayable :: ProjectionOwnerNode -> Bool-isReplayable owner = case poReplay owner of+isReplayable owner = case (.replay) owner of   ProjectionReplayExplicit -> True   ProjectionLiveOnly _ -> False

src/Keiro/Dsl/ProjectionSupply.hs view

@@ -18,12 +18,12 @@ -- normalized by identity; source locations remain available for structured -- diagnostics and generated evidence. data ResolvedProjectionSupply = ResolvedProjectionSupply-  { supplyQueryModel :: !Name,-    supplyProjectionOwner :: !Name,-    supplyRebuildGroup :: !Name,-    supplyObservedTargets :: !(NonEmpty Name),-    supplyQueryLoc :: !Loc,-    supplyOwnerLoc :: !Loc+  { queryModel :: !Name,+    projectionOwner :: !Name,+    rebuildGroup :: !Name,+    observedTargets :: !(NonEmpty Name),+    queryLoc :: !Loc,+    ownerLoc :: !Loc   }   deriving stock (Eq, Show) @@ -57,45 +57,45 @@   where     catalogReadModels =       sortOn-        rmName+        (.name)         [ readModel-        | NReadModel readModel <- specNodes spec,-          rmGroup readModel /= Nothing+        | NReadModel readModel <- (.nodes) spec,+          (.group) readModel /= Nothing         ]     targetsByName =       Map.fromList-        [ (ptName target, target)-        | NProjectionTarget target <- specNodes spec+        [ ((.name) target, target)+        | NProjectionTarget target <- (.nodes) spec         ]     groupsByTarget =       Map.fromListWith         (<>)-        [ (targetName, [rgName groupNode])-        | NRebuildGroup groupNode <- specNodes spec,-          targetName <- rgTargets groupNode+        [ (targetName, [(.name) groupNode])+        | NRebuildGroup groupNode <- (.nodes) spec,+          targetName <- (.targets) groupNode         ]     ownersByTarget =       Map.fromListWith         (<>)         [ (targetName, [owner])-        | NProjectionOwner owner <- specNodes spec,-          targetName <- poTargets owner+        | NProjectionOwner owner <- (.nodes) spec,+          targetName <- (.targets) owner         ]     legacyProjections =       [ (aggregate, projection)-      | NAggregate aggregate <- specNodes spec,-        Just projection <- [aggProjection aggregate]+      | NAggregate aggregate <- (.nodes) spec,+        Just projection <- [(.projection) aggregate]       ]      analyzeReadModel readModel =       (resolved, sortOn issueSortKey (legacyIssues <> structuralIssues))       where-        observedTargets = sort (nub (rmObservedTargets readModel))-        queryGroup = maybe (error "catalog read model lost its group") id (rmGroup readModel)+        observedTargets = sort (nub ((.observedTargets) readModel))+        queryGroup = maybe (error "catalog read model lost its group") id ((.group) readModel)         legacyIssues =           [ SupplyLegacyProjectionConflict readModel aggregate projection           | (aggregate, projection) <- legacyProjections,-            projTable projection == rmName readModel+            (.table) projection == (.name) readModel           ]         targetIssues = concatMap (issuesForTarget readModel queryGroup) observedTargets         structuralIssues@@ -106,11 +106,11 @@               [owner] ->                 [ SupplyOwnerGroupMismatch readModel targetName owner                 | targetName <- observedTargets,-                  poGroup owner /= queryGroup+                  (.group) owner /= queryGroup                 ]               owners -> [SupplyQueryWithMultipleOwners readModel owners]         supplierOwners =-          sortOn poName+          sortOn (.name)             . nubByOwner             $ [ owner               | targetName <- observedTargets,@@ -120,14 +120,14 @@           [] -> case supplierOwners of             [owner] ->               [ ResolvedProjectionSupply-                  { supplyQueryModel = rmName readModel,-                    supplyProjectionOwner = poName owner,-                    supplyRebuildGroup = queryGroup,-                    supplyObservedTargets = case observedTargets of+                  { queryModel = (.name) readModel,+                    projectionOwner = (.name) owner,+                    rebuildGroup = queryGroup,+                    observedTargets = case observedTargets of                       target : rest -> target :| rest                       [] -> error "resolved projection supply lost observed targets",-                    supplyQueryLoc = rmLoc readModel,-                    supplyOwnerLoc = poLoc owner+                    queryLoc = (.loc) readModel,+                    ownerLoc = (.loc) owner                   }               ]             _ -> []@@ -143,21 +143,21 @@           [ SupplyObservedTargetOutsideGroup readModel targetName           | Map.findWithDefault [] targetName groupsByTarget /= [queryGroup]           ]-        ownerIssues = case sortOn poName (Map.findWithDefault [] targetName ownersByTarget) of+        ownerIssues = case sortOn (.name) (Map.findWithDefault [] targetName ownersByTarget) of           [] -> [SupplyObservedTargetWithoutOwner readModel targetName]           [_] -> []           owners -> [SupplyObservedTargetWithMultipleOwners readModel targetName owners] -    nubByOwner = Map.elems . Map.fromList . map (\owner -> (poName owner, owner))+    nubByOwner = Map.elems . Map.fromList . map (\owner -> ((.name) owner, owner))  issueSortKey :: ProjectionSupplyIssue -> (Name, Int, Name) issueSortKey = \case-  SupplyObservedTargetsEmpty readModel -> (rmName readModel, 0, "")-  SupplyObservedTargetUnknown readModel targetName -> (rmName readModel, 1, targetName)-  SupplyObservedTargetOutsideGroup readModel targetName -> (rmName readModel, 2, targetName)-  SupplyObservedTargetWithoutOwner readModel targetName -> (rmName readModel, 3, targetName)-  SupplyObservedTargetWithMultipleOwners readModel targetName _ -> (rmName readModel, 4, targetName)-  SupplyOwnerGroupMismatch readModel targetName _ -> (rmName readModel, 5, targetName)-  SupplyQueryWithoutOwner readModel -> (rmName readModel, 6, "")-  SupplyQueryWithMultipleOwners readModel _ -> (rmName readModel, 7, "")-  SupplyLegacyProjectionConflict readModel aggregate _ -> (rmName readModel, 8, aggName aggregate)+  SupplyObservedTargetsEmpty readModel -> ((.name) readModel, 0, "")+  SupplyObservedTargetUnknown readModel targetName -> ((.name) readModel, 1, targetName)+  SupplyObservedTargetOutsideGroup readModel targetName -> ((.name) readModel, 2, targetName)+  SupplyObservedTargetWithoutOwner readModel targetName -> ((.name) readModel, 3, targetName)+  SupplyObservedTargetWithMultipleOwners readModel targetName _ -> ((.name) readModel, 4, targetName)+  SupplyOwnerGroupMismatch readModel targetName _ -> ((.name) readModel, 5, targetName)+  SupplyQueryWithoutOwner readModel -> ((.name) readModel, 6, "")+  SupplyQueryWithMultipleOwners readModel _ -> ((.name) readModel, 7, "")+  SupplyLegacyProjectionConflict readModel aggregate _ -> ((.name) readModel, 8, (.name) aggregate)

src/Keiro/Dsl/ReadModelQueryContract.hs view

@@ -32,17 +32,17 @@   deriving stock (Eq, Ord, Show)  data QueryContractIdentity = QueryContractIdentity-  { qciReadModel :: !Name,-    qciPosition :: !QueryContractPosition,-    qciTypeExpression :: !Text,-    qciMappedDependencies :: ![Name]+  { readModel :: !Name,+    position :: !QueryContractPosition,+    typeExpression :: !Text,+    mappedDependencies :: ![Name]   }   deriving stock (Eq, Ord, Show)  data QueryContractDrift = QueryContractDrift-  { qcdKey :: !(Name, QueryContractPosition),-    qcdPrevious :: !(Maybe QueryContractIdentity),-    qcdCurrent :: !(Maybe QueryContractIdentity)+  { key :: !(Name, QueryContractPosition),+    previous :: !(Maybe QueryContractIdentity),+    current :: !(Maybe QueryContractIdentity)   }   deriving stock (Eq, Show) @@ -61,10 +61,10 @@ instance ToJSON QueryContractIdentity where   toJSON identity =     object-      [ "readModel" .= qciReadModel identity,-        "position" .= qciPosition identity,-        "typeExpression" .= qciTypeExpression identity,-        "mappedDependencies" .= qciMappedDependencies identity+      [ "readModel" .= (.readModel) identity,+        "position" .= (.position) identity,+        "typeExpression" .= (.typeExpression) identity,+        "mappedDependencies" .= (.mappedDependencies) identity       ]  instance FromJSON QueryContractIdentity where@@ -76,7 +76,7 @@       <*> fields .: "mappedDependencies"  queryContractIdentityKey :: QueryContractIdentity -> (Name, QueryContractPosition)-queryContractIdentityKey identity = (qciReadModel identity, qciPosition identity)+queryContractIdentityKey identity = ((.readModel) identity, (.position) identity)  queryContractDrift :: [QueryContractIdentity] -> [QueryContractIdentity] -> [QueryContractDrift] queryContractDrift current previous =@@ -99,16 +99,16 @@   fmap (sortOn queryContractIdentityKey . concat) (traverse (identitiesFor graph) readModels)   where     spec = checkedSpec service-    readModels = [readModel | NReadModel readModel <- specNodes spec]+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]  identitiesFor :: TypeGraph -> ReadModelNode -> Either (NonEmpty TypeGraphError) [QueryContractIdentity] identitiesFor _ ReadModelNode {queryTypes = Nothing} = Right [] identitiesFor graph readModel@ReadModelNode {queryTypes = Just queryPair} = do-  inputExpression <- resolve QueryInputConsumer (inputLoc queryPair) (input queryPair)-  resultExpression <- resolve QueryResultConsumer (resultLoc queryPair) (result queryPair)+  inputExpression <- resolve QueryInputConsumer ((.inputLoc) queryPair) ((.input) queryPair)+  resultExpression <- resolve QueryResultConsumer ((.resultLoc) queryPair) ((.result) queryPair)   pure-    [ identity QueryInputConsumer (input queryPair) inputExpression,-      identity QueryResultConsumer (result queryPair) resultExpression+    [ identity QueryInputConsumer ((.input) queryPair) inputExpression,+      identity QueryResultConsumer ((.result) queryPair) resultExpression     ]   where     resolve position location expression =@@ -116,13 +116,13 @@         Left failure -> Left (failure :| [])         Right resolved -> Right resolved       where-        owner = "readmodel '" <> rmName readModel <> "' query " <> positionLabel position+        owner = "readmodel '" <> (.name) readModel <> "' query " <> positionLabel position     identity position sourceExpression resolved =       QueryContractIdentity-        { qciReadModel = rmName readModel,-          qciPosition = position,-          qciTypeExpression = renderTypeExpr sourceExpression,-          qciMappedDependencies = Set.toAscList (Set.map unMappedKey (mappedClosure graph resolved))+        { readModel = (.name) readModel,+          position = position,+          typeExpression = renderTypeExpr sourceExpression,+          mappedDependencies = Set.toAscList (Set.map unMappedKey (mappedClosure graph resolved))         }  mappedClosure :: TypeGraph -> ResolvedTypeExpr -> Set MappedKey@@ -139,7 +139,7 @@         onOptional = id,         onList = id,         onMap = id,-        onRef = \key -> Set.insert key (Map.findWithDefault Set.empty key (tgReachability graph))+        onRef = \key -> Set.insert key (Map.findWithDefault Set.empty key ((.reachability) graph))       }  positionLabel :: QueryContractPosition -> Text

src/Keiro/Dsl/ReadModelShape.hs view

@@ -23,17 +23,17 @@ -- do not duplicate physical authority owned by their target declarations. canonicalShape :: ReadModelNode -> Text canonicalShape readModel =-  T.intercalate "|" (shapeRoot : map columnSegment (rmColumns readModel))+  T.intercalate "|" (shapeRoot : map columnSegment ((.columns) readModel))   where-    shapeRoot = case rmGroup readModel of-      Nothing -> rmTable readModel+    shapeRoot = case (.group) readModel of+      Nothing -> (.table) readModel       Just _ -> "query-model"     columnSegment columnDecl =       T.intercalate         ":"-        [ rmcName columnDecl,-          rmcType columnDecl,-          if rmcRequired columnDecl then "req" else "null"+        [ (.rmcName) columnDecl,+          (.rmcType) columnDecl,+          if (.rmcRequired) columnDecl then "req" else "null"         ]  -- | A fixed-width FNV-1a-64 digest over the canonical shape's UTF-8 bytes.@@ -51,13 +51,13 @@  -- | The runtime registry identity derived from context and notation name. registryNameFor :: Name -> ReadModelNode -> Text-registryNameFor contextName readModel =-  contextName <> "-" <> T.replace "_" "-" (rmName readModel)+registryNameFor name readModel =+  name <> "-" <> T.replace "_" "-" ((.name) readModel)  -- | The explicit subscription override or its deterministic default. subscriptionNameFor :: Name -> ReadModelNode -> Text-subscriptionNameFor contextName readModel =-  fromMaybe (registryNameFor contextName readModel <> "-sub") (legacyReadModelSubscription readModel)+subscriptionNameFor name readModel =+  fromMaybe (registryNameFor name readModel <> "-sub") (legacyReadModelSubscription readModel)  offsetBasis :: Word64 offsetBasis = 0xcbf29ce484222325

src/Keiro/Dsl/ReplayImpact.hs view

@@ -70,8 +70,8 @@ instance ToJSON AggregateImpact where   toJSON impact =     object-      [ "eventTypes" .= Set.toAscList (eventTypes impact),-        "includeSnapshotStreams" .= includeSnapshotStreams impact+      [ "eventTypes" .= Set.toAscList ((.eventTypes) impact),+        "includeSnapshotStreams" .= (.includeSnapshotStreams) impact       ]  instance ToJSON ReplayImpact where@@ -87,11 +87,11 @@   toJSON impact@CatalogReplayAffected {} =     object       [ "verdict" .= ("catalog-replay-affected" :: Text),-        "groups" .= Set.toAscList (affectedGroups impact),-        "targets" .= Set.toAscList (affectedTargets impact),-        "sources" .= Set.toAscList (affectedSources impact),-        "adapters" .= Set.toAscList (affectedAdapters impact),-        "invalidatesRunningFingerprint" .= invalidatesRunningFingerprint impact+        "groups" .= Set.toAscList ((.affectedGroups) impact),+        "targets" .= Set.toAscList ((.affectedTargets) impact),+        "sources" .= Set.toAscList ((.affectedSources) impact),+        "adapters" .= Set.toAscList ((.affectedAdapters) impact),+        "invalidatesRunningFingerprint" .= (.invalidatesRunningFingerprint) impact       ]  catalogReplayImpactServices :: CheckedService -> CheckedService -> CatalogReplayImpact@@ -108,26 +108,26 @@   where     oldSpec = checkedSpec oldService     newSpec = checkedSpec newService-    oldTargets = Map.fromList [(ptName target, target) | NProjectionTarget target <- specNodes oldSpec]-    newTargets = Map.fromList [(ptName target, target) | NProjectionTarget target <- specNodes newSpec]-    oldGroups = Map.fromList [(rgName groupNode, groupNode) | NRebuildGroup groupNode <- specNodes oldSpec]-    newGroups = Map.fromList [(rgName groupNode, groupNode) | NRebuildGroup groupNode <- specNodes newSpec]-    oldOwners = Map.fromList [(poName owner, owner) | NProjectionOwner owner <- specNodes oldSpec]-    newOwners = Map.fromList [(poName owner, owner) | NProjectionOwner owner <- specNodes newSpec]+    oldTargets = Map.fromList [((.name) target, target) | NProjectionTarget target <- (.nodes) oldSpec]+    newTargets = Map.fromList [((.name) target, target) | NProjectionTarget target <- (.nodes) newSpec]+    oldGroups = Map.fromList [((.name) groupNode, groupNode) | NRebuildGroup groupNode <- (.nodes) oldSpec]+    newGroups = Map.fromList [((.name) groupNode, groupNode) | NRebuildGroup groupNode <- (.nodes) newSpec]+    oldOwners = Map.fromList [((.name) owner, owner) | NProjectionOwner owner <- (.nodes) oldSpec]+    newOwners = Map.fromList [((.name) owner, owner) | NProjectionOwner owner <- (.nodes) newSpec]     changedTargetNames = changedKeys oldTargets newTargets     changedGroupNames = changedKeys oldGroups newGroups     changedOwnerNames = changedKeys oldOwners newOwners     changedOwners = mapMaybe (`Map.lookup` oldOwners) (Set.toList changedOwnerNames) <> mapMaybe (`Map.lookup` newOwners) (Set.toList changedOwnerNames)     changedGroups = mapMaybe (`Map.lookup` oldGroups) (Set.toList changedGroupNames) <> mapMaybe (`Map.lookup` newGroups) (Set.toList changedGroupNames)-    groups = changedGroupNames <> Set.fromList (map poGroup changedOwners) <> groupsContainingChangedTargets <> inheritedGroups-    targets = changedTargetNames <> Set.fromList (concatMap poTargets changedOwners <> concatMap rgTargets changedGroups) <> inheritedTargets-    sources = Set.fromList (map renderSource (concatMap poSources changedOwners)) <> inheritedSources+    groups = changedGroupNames <> Set.fromList (map (.group) changedOwners) <> groupsContainingChangedTargets <> inheritedGroups+    targets = changedTargetNames <> Set.fromList (concatMap (.targets) changedOwners <> concatMap (.targets) changedGroups) <> inheritedTargets+    sources = Set.fromList (map renderSource (concatMap (.sources) changedOwners)) <> inheritedSources     adapters = changedOwnerNames <> inheritedAdapters     groupsContainingChangedTargets =       Set.fromList-        [ rgName groupNode+        [ (.name) groupNode         | groupNode <- Map.elems oldGroups <> Map.elems newGroups,-          any (`Set.member` changedTargetNames) (rgTargets groupNode)+          any (`Set.member` changedTargetNames) ((.targets) groupNode)         ]     changedKeys oldMap newMap =       Set.fromList@@ -154,8 +154,8 @@         operationFingerprint oldOperation /= operationFingerprint newOperation,         maybe False operationReplayable oldOperation || maybe False operationReplayable newOperation       ]-    oldMappedOperations = maybe Map.empty ProjectionImpact.operations (projectionImpactFor oldService)-    newMappedOperations = maybe Map.empty ProjectionImpact.operations (projectionImpactFor newService)+    oldMappedOperations = maybe Map.empty (.operations) (projectionImpactFor oldService)+    newMappedOperations = maybe Map.empty (.operations) (projectionImpactFor newService)     projectionImpactFor service = case checkedTypeGraph service of       Left _ -> Nothing       Right graph -> Just (ProjectionImpact.projectionMappedImpact service (semanticImpact graph))@@ -200,24 +200,24 @@     newSymbols = aggregateSymbolsFromGraphResult newGraphResult newSpec     oldContext = ReplaySurfaceContext oldSpec oldGraphResult oldSymbols     newContext = ReplaySurfaceContext newSpec newGraphResult newSymbols-    oldAggregates = [(aggName aggregate, aggregate) | NAggregate aggregate <- specNodes (surfaceSpec oldContext)]-    newAggregates = Map.fromList [(aggName aggregate, aggregate) | NAggregate aggregate <- specNodes (surfaceSpec newContext)]+    oldAggregates = [((.name) aggregate, aggregate) | NAggregate aggregate <- (.nodes) ((.spec) oldContext)]+    newAggregates = Map.fromList [((.name) aggregate, aggregate) | NAggregate aggregate <- (.nodes) ((.spec) newContext)]  data ReplaySurfaceContext = ReplaySurfaceContext-  { surfaceSpec :: !Spec,-    surfaceGraphResult :: Either (NE.NonEmpty TypeGraphError) TypeGraph,-    surfaceSymbols :: AggregateSymbols+  { spec :: !Spec,+    graphResult :: Either (NE.NonEmpty TypeGraphError) TypeGraph,+    symbols :: AggregateSymbols   }  hasImpact :: AggregateImpact -> Bool hasImpact impact =-  not (Set.null (eventTypes impact))-    || includeSnapshotStreams impact+  not (Set.null ((.eventTypes) impact))+    || (.includeSnapshotStreams) impact  removedAggregateImpact :: Aggregate -> AggregateImpact removedAggregateImpact aggregate =   AggregateImpact-    { eventTypes = Set.fromList (evName <$> aggEvents aggregate),+    { eventTypes = Set.fromList ((.name) <$> (.events) aggregate),       includeSnapshotStreams = True     } @@ -227,7 +227,7 @@   newNonTransitionSurface <-     aggregateFoldSurfaceForService       newService-      newAggregate {aggTransitions = aggTransitions oldAggregate}+      (replaceAggregateTransitions oldAggregate.transitions newAggregate)   let nonTransitionFoldChanged = oldSurface /= newNonTransitionSurface   pure     AggregateImpact@@ -238,34 +238,34 @@         includeSnapshotStreams = transitionFoldChanged || nonTransitionFoldChanged || mappedRegisterChanged       }   where-    oldEventTypes = Set.fromList (evName <$> aggEvents oldAggregate)+    oldEventTypes = Set.fromList ((.name) <$> (.events) oldAggregate)     decodeAffected = decodeSurfaceAffected oldContext newContext oldAggregate newAggregate     mappedRegisterChanged =       mappedRegisterSurface oldContext oldAggregate         /= mappedRegisterSurface newContext newAggregate     (transitionAffected, transitionFoldChanged) =-      changedTransitionEvents (aggTransitions oldAggregate) (aggTransitions newAggregate)+      changedTransitionEvents ((.transitions) oldAggregate) ((.transitions) newAggregate)  decodeSurfaceAffected :: ReplaySurfaceContext -> ReplaySurfaceContext -> Aggregate -> Aggregate -> Set Name decodeSurfaceAffected oldContext newContext oldAggregate newAggregate =   removedOrChanged <> wireAffected   where-    newEvents = Map.fromList [(evName event, event) | event <- aggEvents newAggregate]+    newEvents = Map.fromList [((.name) event, event) | event <- (.events) newAggregate]     removedOrChanged =       Set.fromList-        [ evName oldEvent-        | oldEvent <- aggEvents oldAggregate,-          maybe True ((/= eventSurface oldContext oldAggregate oldEvent) . eventSurface newContext newAggregate) (Map.lookup (evName oldEvent) newEvents)+        [ (.name) oldEvent+        | oldEvent <- (.events) oldAggregate,+          maybe True ((/= eventSurface oldContext oldAggregate oldEvent) . eventSurface newContext newAggregate) (Map.lookup ((.name) oldEvent) newEvents)         ]     wireAffected-      | aggWire oldAggregate == aggWire newAggregate = Set.empty-      | otherwise = Set.fromList (evName <$> aggEvents oldAggregate)+      | (.wire) oldAggregate == (.wire) newAggregate = Set.empty+      | otherwise = Set.fromList ((.name) <$> (.events) oldAggregate)  eventDecodeSurface :: Aggregate -> Event -> (Int, Maybe (Int, Hole), [(Name, Text, Maybe TypeExpr)]) eventDecodeSurface aggregate event =-  ( evVersion event,-    evUpcastFrom event,-    [ (fieldDslName identity, fieldWireKey identity, aggregateFieldType field)+  ( (.version) event,+    (.upcastFrom) event,+    [ ((.dslName) identity, (.wireKey) identity, (.valueType) field)     | field <- eventFields aggregate event,       let identity = resolveAggregateFieldIdentity field     ]@@ -278,17 +278,17 @@ mappedFieldSurface :: ReplaySurfaceContext -> Aggregate -> Event -> [(Name, Text)] mappedFieldSurface context aggregate event = mapped <> nominal   where-    mapped = case surfaceGraphResult context of+    mapped = case (.graphResult) context of       Left _ -> []       Right graph ->-        [ (aggregateFieldName field, wireFingerprint graph typeName)+        [ ((.name) field, wireFingerprint graph typeName)         | field <- eventFields aggregate event,-          TRef typeName <- maybeToList (aggregateFieldType field),-          Map.member (MappedKey typeName) (tgDeclarations graph)+          TRef typeName <- maybeToList ((.valueType) field),+          Map.member (MappedKey typeName) ((.declarations) graph)         ]-    symbols = surfaceSymbols context+    symbols = (.symbols) context     nominal =-      [ (aggregateFieldName field, nominalSurface resolved)+      [ ((.name) field, nominalSurface resolved)       | field <- eventFields aggregate event,         Right (AggregateNominal resolved) <- [inferAggregateFieldType symbols aggregate EventFieldUse field]       ]@@ -296,33 +296,33 @@ mappedRegisterSurface :: ReplaySurfaceContext -> Aggregate -> [(Name, Name, Text)] mappedRegisterSurface context aggregate = mapped <> nominal   where-    mapped = case surfaceGraphResult context of+    mapped = case (.graphResult) context of       Left _ -> []       Right graph ->-        [ (regName register, typeName, wireFingerprint graph typeName)-        | register <- aggRegs aggregate,-          TRef typeName <- [regType register],-          Map.member (MappedKey typeName) (tgDeclarations graph)+        [ ((.name) register, typeName, wireFingerprint graph typeName)+        | register <- (.regs) aggregate,+          TRef typeName <- [(.valueType) register],+          Map.member (MappedKey typeName) ((.declarations) graph)         ]-    symbols = surfaceSymbols context+    symbols = (.symbols) context     nominal =-      [ (regName register, resolvedNominalName resolved, nominalSurface resolved)-      | register <- aggRegs aggregate,-        Right (AggregateNominal resolved) <- [resolveAggregateType symbols (regLoc register) RegisterUse (regType register)]+      [ ((.name) register, (.name) resolved, nominalSurface resolved)+      | register <- (.regs) aggregate,+        Right (AggregateNominal resolved) <- [resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register)]       ]  nominalSurface :: ResolvedNominalType -> Text nominalSurface nominal =-  nominalRepresentationSurface (resolvedNominalRepresentation nominal)-    <> case resolvedNominalOwnership nominal of+  nominalRepresentationSurface ((.representation) nominal)+    <> case (.ownership) nominal of       GeneratedNominal -> "|ownership=generated"       ConsumerNominal binding ->         Text.concat           [ "|ownership=consumer",-            "|canonical=" <> unCanonicalTypeId (consumerNominalCanonical binding),-            "|binding=" <> unQualifiedValueName (consumerNominalBinding binding),-            "|binding-version=" <> unBindingVersion (consumerNominalBindingVersion binding),-            "|initial=" <> maybe "(none)" unQualifiedValueName (consumerNominalInitial binding)+            "|canonical=" <> (.unCanonicalTypeId) ((.canonical) binding),+            "|binding=" <> (.unQualifiedValueName) ((.binding) binding),+            "|binding-version=" <> (.unBindingVersion) ((.bindingVersion) binding),+            "|initial=" <> maybe "(none)" (.unQualifiedValueName) ((.initial) binding)           ]  nominalRepresentationSurface :: NominalRepresentation -> Text@@ -337,10 +337,10 @@     NominalTime -> "scalar:Time"  eventFields :: Aggregate -> Event -> [AggregateField]-eventFields aggregate event = case evBody event of+eventFields aggregate event = case (.body) event of   EventFields fields -> fields   EventFromCommand commandName ->-    concat [cmdFields command | command <- aggCommands aggregate, cmdName command == commandName]+    concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName]  maybeToList :: Maybe a -> [a] maybeToList = maybe [] pure@@ -371,15 +371,15 @@       Map.fromListWith (<>)         . map (\transition -> (transitionIdentity transition, [transition]))     transitionIdentity transition =-      ( modeKey (tMode transition),-        tSource transition,-        tCommand transition+      ( modeKey ((.mode) transition),+        (.source) transition,+        (.command) transition       )     modeKey TmLive = "live" :: Text     modeKey TmReplayOnly = "replay-only"     transitionSortKey transition =-      (maybe "" canonicalExpr (tGuard transition), canonicalTransition transition)-    emittedBy = Set.fromList . tEmits+      (maybe "" canonicalExpr ((.guard) transition), canonicalTransition transition)+    emittedBy = Set.fromList . (.emits)  -- | Remove byte-identical transitions as a multiset. Sorting makes duplicate -- cancellation independent of declaration order.@@ -413,9 +413,9 @@         guardOnlyLoosening oldTransition newTransition       ]     looseningPairKey (oldTransition, newTransition) =-      ( maybe "" canonicalExpr (tGuard oldTransition),+      ( maybe "" canonicalExpr ((.guard) oldTransition),         canonicalTransition oldTransition,-        maybe "" canonicalExpr (tGuard newTransition),+        maybe "" canonicalExpr ((.guard) newTransition),         canonicalTransition newTransition       ) @@ -426,9 +426,42 @@ -- conjunction elimination, and disjunction introduction. guardOnlyLoosening :: Transition -> Transition -> Bool guardOnlyLoosening oldTransition newTransition =-  oldTransition {tGuard = tGuard newTransition} == newTransition-    && guardImplies (tGuard oldTransition) (tGuard newTransition)+  replaceTransitionGuard newTransition.guard oldTransition == newTransition+    && guardImplies oldTransition.guard newTransition.guard +replaceAggregateTransitions :: [Transition] -> Aggregate -> Aggregate+replaceAggregateTransitions transitions aggregate =+  Aggregate+    { name = aggregate.name,+      regs = aggregate.regs,+      states = aggregate.states,+      commands = aggregate.commands,+      events = aggregate.events,+      transitions,+      domainOutcomeTypes = aggregate.domainOutcomeTypes,+      domainOutcomeDuplicateLocs = aggregate.domainOutcomeDuplicateLocs,+      wire = aggregate.wire,+      projection = aggregate.projection,+      snapshot = aggregate.snapshot,+      loc = aggregate.loc+    }++replaceTransitionGuard :: Maybe Expr -> Transition -> Transition+replaceTransitionGuard guard transition =+  Transition+    { source = transition.source,+      command = transition.command,+      implementation = transition.implementation,+      guard,+      writes = transition.writes,+      emits = transition.emits,+      outcome = transition.outcome,+      outcomeDuplicateLocs = transition.outcomeDuplicateLocs,+      goto = transition.goto,+      mode = transition.mode,+      loc = transition.loc+    }+ guardImplies :: Maybe Expr -> Maybe Expr -> Bool guardImplies _ Nothing = True guardImplies Nothing (Just _) = False@@ -451,8 +484,8 @@       "; "       [ aggregateName           <> " events=["-          <> Text.intercalate "," (Set.toAscList (eventTypes impact))+          <> Text.intercalate "," (Set.toAscList ((.eventTypes) impact))           <> "] snapshots="-          <> if includeSnapshotStreams impact then "yes" else "no"+          <> if (.includeSnapshotStreams) impact then "yes" else "no"       | (aggregateName, impact) <- Map.toAscList aggregates       ]

src/Keiro/Dsl/RouterSelection.hs view

@@ -43,28 +43,28 @@ import Keiro.Dsl.AggregateType import Keiro.Dsl.Grammar import Keiro.Dsl.LanguageVersion (LanguageFeature (DeclarativeRouterSelectionSyntax), languageSupportsFeature)-import Keiro.Dsl.SemanticContract (EffectiveLanguageContract, effectiveContractLanguageVersion)+import Keiro.Dsl.SemanticContract (EffectiveLanguageContract (..)) import Keiro.Dsl.TypeGraph import Numeric (showHex) import Numeric.Natural (Natural)  data CheckedReadModelQuery = CheckedReadModelQuery-  { checkedQueryName :: !Name,-    checkedQueryInputType :: !ResolvedTypeExpr,-    checkedQueryResultType :: !ResolvedTypeExpr+  { name :: !Name,+    inputType :: !ResolvedTypeExpr,+    resultType :: !ResolvedTypeExpr   }   deriving stock (Eq, Show, Generic)  data CheckedMappedExpr = CheckedMappedExpr-  { checkedMappedExprRoot :: !SelectionRoot,-    checkedMappedExprType :: !ResolvedTypeExpr+  { root :: !SelectionRoot,+    valueType :: !ResolvedTypeExpr   }   deriving stock (Eq, Show, Generic)  data CheckedMappedType = CheckedMappedType-  { checkedMappedTypeKey :: !MappedKey,-    checkedMappedTypeConstructor :: !Name,-    checkedMappedTypeFields :: ![ResolvedWireField]+  { key :: !MappedKey,+    constructor :: !Name,+    fields :: ![ResolvedWireField]   }   deriving stock (Eq, Show, Generic) @@ -81,16 +81,16 @@   deriving stock (Eq, Ord, Show, Generic)  data CheckedSelectionPathSegment = CheckedSelectionPathSegment-  { checkedPathField :: !Name,-    checkedPathWireKey :: !Text,-    checkedPathOwner :: !MappedKey+  { field :: !Name,+    wireKey :: !Text,+    owner :: !MappedKey   }   deriving stock (Eq, Ord, Show, Generic)  data CheckedScalarExpr = CheckedScalarExpr-  { checkedScalarType :: !SelectionScalarType,-    checkedScalarNode :: !CheckedScalarNode,-    checkedScalarLoc :: !Loc+  { valueType :: !SelectionScalarType,+    node :: !CheckedScalarNode,+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -130,26 +130,26 @@   deriving stock (Eq, Ord, Show, Generic)  data CheckedRouterSelection = CheckedRouterSelection-  { checkedIdentity :: !Text,-    checkedVersion :: !Natural,-    checkedQuery :: !CheckedReadModelQuery,-    checkedInputBinding :: !CheckedMappedExpr,-    checkedRowBinding :: !CheckedMappedType,-    checkedKey :: !CheckedScalarExpr,-    checkedPredicate :: !CheckedScalarExpr,-    checkedRecipient :: !CheckedScalarExpr,-    checkedCommandFields :: !(Map Name CheckedScalarExpr),-    checkedTarget :: !Name,-    checkedCommand :: !Name,-    checkedLimit :: !Natural,-    checkedOrder :: !CheckedSelectionOrder,-    checkedDedupe :: !CheckedSelectionDedupe,-    checkedEmptyPolicy :: !CheckedEmptySelectionPolicy,-    checkedFailurePolicy :: !CheckedSelectionFailurePolicy,-    checkedRedeliveryPolicy :: !CheckedRedeliveryPolicy,-    checkedPartialPolicy :: !CheckedPartialDispatchPolicy,-    checkedFingerprint :: !Text,-    checkedUseSites :: ![UseSite]+  { identity :: !Text,+    version :: !Natural,+    query :: !CheckedReadModelQuery,+    inputBinding :: !CheckedMappedExpr,+    rowBinding :: !CheckedMappedType,+    key :: !CheckedScalarExpr,+    predicate :: !CheckedScalarExpr,+    recipient :: !CheckedScalarExpr,+    commandFields :: !(Map Name CheckedScalarExpr),+    target :: !Name,+    command :: !Name,+    limit :: !Natural,+    order :: !CheckedSelectionOrder,+    dedupe :: !CheckedSelectionDedupe,+    emptyPolicy :: !CheckedEmptySelectionPolicy,+    failurePolicy :: !CheckedSelectionFailurePolicy,+    redeliveryPolicy :: !CheckedRedeliveryPolicy,+    partialPolicy :: !CheckedPartialDispatchPolicy,+    fingerprint :: !Text,+    useSites :: ![UseSite]   }   deriving stock (Eq, Show, Generic) @@ -186,16 +186,16 @@   deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)  data RouterSelectionDiagnostic = RouterSelectionDiagnostic-  { selectionDiagnosticLoc :: !Loc,-    selectionDiagnosticCode :: !RouterSelectionDiagnosticCode,-    selectionDiagnosticMessage :: !Text+  { loc :: !Loc,+    code :: !RouterSelectionDiagnosticCode,+    message :: !Text   }   deriving stock (Eq, Show, Generic)  checkRouterSelection :: EffectiveLanguageContract -> TypeGraph -> Spec -> RouterNode -> Either (NonEmpty RouterSelectionDiagnostic) CheckedRouterSelection-checkRouterSelection languageContract graph spec router = case rvSource (rtResolve router) of-  ResolveReadModel {} -> selectionFailure (rvLoc (rtResolve router)) SelectionNotDeclarative "custom-unverified router selection has no checked declarative contract"-  ResolveHole -> selectionFailure (rvLoc (rtResolve router)) SelectionNotDeclarative "custom-unverified router selection has no checked declarative contract"+checkRouterSelection languageContract graph spec router = case (.source) ((.resolve) router) of+  ResolveReadModel {} -> selectionFailure ((.loc) ((.resolve) router)) SelectionNotDeclarative "custom-unverified router selection has no checked declarative contract"+  ResolveHole -> selectionFailure ((.loc) ((.resolve) router)) SelectionNotDeclarative "custom-unverified router selection has no checked declarative contract"   ResolveDeclarative declaration -> checkDeclaration declaration   where     symbols = aggregateSymbolsFromGraph graph spec@@ -203,149 +203,173 @@     checkDeclaration declaration = do       requireFeature declaration       identity <- requireIdentity declaration-      version <- requirePositive (rsVersionLoc declaration) SelectionVersionInvalid "selection version" (rsVersion declaration)-      recipientLimit <- case rsLimit declaration of-        Nothing -> selectionFailure (rsLoc declaration) SelectionRecipientLimitMissing "declarative router selection requires a positive max-recipients"+      version <- requirePositive ((.versionLoc) declaration) SelectionVersionInvalid "selection version" ((.version) declaration)+      recipientLimit <- case (.limit) declaration of+        Nothing -> selectionFailure ((.loc) declaration) SelectionRecipientLimitMissing "declarative router selection requires a positive max-recipients"         Just (value, valueLoc) -> requirePositive valueLoc SelectionRecipientLimitInvalid "max-recipients" value-      order <- requireExact (rsOrderLoc declaration) SelectionOrderUnsupported "order" "target-stream" CheckedOrderByTargetStream (rsOrder declaration)-      dedupe <- requireExact (rsDedupeLoc declaration) SelectionDedupeUnsupported "dedupe" "target-stream" CheckedDedupeByTargetStream (rsDedupe declaration)+      order <- requireExact ((.orderLoc) declaration) SelectionOrderUnsupported "order" "target-stream" CheckedOrderByTargetStream ((.order) declaration)+      dedupe <- requireExact ((.dedupeLoc) declaration) SelectionDedupeUnsupported "dedupe" "target-stream" CheckedDedupeByTargetStream ((.dedupe) declaration)       emptyPolicy <- checkEmptyPolicy declaration       failurePolicy <- checkFailurePolicy declaration-      redelivery <- requireExact (rsRedeliveryLoc declaration) SelectionRedeliveryUnsupported "redelivery" "stable-union" CheckedStableUnion (rsRedelivery declaration)-      partial <- requireExact (rsPartialLoc declaration) SelectionPartialDispatchUnsupported "partial" "retain-successes" CheckedRetainSuccesses (rsPartial declaration)+      redelivery <- requireExact ((.redeliveryLoc) declaration) SelectionRedeliveryUnsupported "redelivery" "stable-union" CheckedStableUnion ((.redelivery) declaration)+      partial <- requireExact ((.partialLoc) declaration) SelectionPartialDispatchUnsupported "partial" "retain-successes" CheckedRetainSuccesses ((.partial) declaration)       (query, inputBinding, rowBinding) <- checkQuery declaration-      keyExpression <- resolveSelectionExpr graph (checkedMappedExprType inputBinding) rowBinding Nothing (EPath (inLoc (rtInput router)) UnqualifiedRoot ["input", corrField (rtKey router)])-      requireScalarType (inLoc (rtInput router)) SelectionQueryInputBindingInvalid "router key" SelectionText keyExpression-      predicate <- resolveSelectionExpr graph (checkedMappedExprType inputBinding) rowBinding Nothing (rsPredicate declaration)-      requireScalarType (exprLoc (rsPredicate declaration)) SelectionPredicateNotBool "where predicate" SelectionBool predicate-      recipient <- resolveSelectionExpr graph (checkedMappedExprType inputBinding) rowBinding Nothing (rsRecipient declaration)-      requireScalarType (exprLoc (rsRecipient declaration)) SelectionRecipientNotText "recipient expression" SelectionText recipient+      keyExpression <- resolveSelectionExpr graph ((.valueType) inputBinding) rowBinding Nothing (EPath ((.loc) ((.input) router)) UnqualifiedRoot ["input", (.field) ((.key) router)])+      requireScalarType ((.loc) ((.input) router)) SelectionQueryInputBindingInvalid "router key" SelectionText keyExpression+      predicate <- resolveSelectionExpr graph ((.valueType) inputBinding) rowBinding Nothing ((.predicate) declaration)+      requireScalarType (exprLoc ((.predicate) declaration)) SelectionPredicateNotBool "where predicate" SelectionBool predicate+      recipient <- resolveSelectionExpr graph ((.valueType) inputBinding) rowBinding Nothing ((.recipient) declaration)+      requireScalarType (exprLoc ((.recipient) declaration)) SelectionRecipientNotText "recipient expression" SelectionText recipient       (targetAggregate, targetCommand) <- resolveTargetCommand       commandFields <- checkCommandMappings graph inputBinding rowBinding targetAggregate targetCommand       let initial =             CheckedRouterSelection-              { checkedIdentity = identity,-                checkedVersion = version,-                checkedQuery = query,-                checkedInputBinding = inputBinding,-                checkedRowBinding = rowBinding,-                checkedKey = keyExpression,-                checkedPredicate = predicate,-                checkedRecipient = recipient,-                checkedCommandFields = commandFields,-                checkedTarget = rtTarget router,-                checkedCommand = rdCommand (rtDispatch router),-                checkedLimit = recipientLimit,-                checkedOrder = order,-                checkedDedupe = dedupe,-                checkedEmptyPolicy = emptyPolicy,-                checkedFailurePolicy = failurePolicy,-                checkedRedeliveryPolicy = redelivery,-                checkedPartialPolicy = partial,-                checkedFingerprint = "",-                checkedUseSites = queryUseSites (rsQuery declaration)+              { identity = identity,+                version = version,+                query = query,+                inputBinding = inputBinding,+                rowBinding = rowBinding,+                key = keyExpression,+                predicate = predicate,+                recipient = recipient,+                commandFields = commandFields,+                target = (.target) router,+                command = (.command) ((.dispatch) router),+                limit = recipientLimit,+                order = order,+                dedupe = dedupe,+                emptyPolicy = emptyPolicy,+                failurePolicy = failurePolicy,+                redeliveryPolicy = redelivery,+                partialPolicy = partial,+                fingerprint = "",+                useSites = queryUseSites ((.query) declaration)               }-      pure initial {checkedFingerprint = routerSelectionFingerprint initial}+      pure (setRouterSelectionFingerprint (routerSelectionFingerprint initial) initial)      requireFeature declaration-      | languageSupportsFeature (effectiveContractLanguageVersion languageContract) DeclarativeRouterSelectionSyntax = Right ()-      | otherwise = selectionFailure (rsLoc declaration) SelectionCapabilityUnavailable "declarative router selection requires language keiro-dsl 5"+      | languageSupportsFeature ((.contractLanguageVersion) languageContract) DeclarativeRouterSelectionSyntax = Right ()+      | otherwise = selectionFailure ((.loc) declaration) SelectionCapabilityUnavailable "declarative router selection requires language keiro-dsl 5" +    setRouterSelectionFingerprint fingerprint selection =+      CheckedRouterSelection+        { identity = selection.identity,+          version = selection.version,+          query = selection.query,+          inputBinding = selection.inputBinding,+          rowBinding = selection.rowBinding,+          key = selection.key,+          predicate = selection.predicate,+          recipient = selection.recipient,+          commandFields = selection.commandFields,+          target = selection.target,+          command = selection.command,+          limit = selection.limit,+          order = selection.order,+          dedupe = selection.dedupe,+          emptyPolicy = selection.emptyPolicy,+          failurePolicy = selection.failurePolicy,+          redeliveryPolicy = selection.redeliveryPolicy,+          partialPolicy = selection.partialPolicy,+          fingerprint,+          useSites = selection.useSites+        }+     requireIdentity declaration-      | T.null (T.strip (rsIdentity declaration)) = selectionFailure (rsIdentityLoc declaration) SelectionIdentityEmpty "selection identity must not be empty"-      | otherwise = Right (rsIdentity declaration)+      | T.null (T.strip ((.identity) declaration)) = selectionFailure ((.identityLoc) declaration) SelectionIdentityEmpty "selection identity must not be empty"+      | otherwise = Right ((.identity) declaration) -    checkEmptyPolicy declaration = case rsEmptyPolicy declaration of+    checkEmptyPolicy declaration = case (.emptyPolicy) declaration of       SelectionAck -> Right CheckedEmptyAck       SelectionRetry -> Right CheckedEmptyRetry       SelectionDeadLetter -> Right CheckedEmptyDeadLetter       SelectionHalt -> Right CheckedEmptyHalt -    checkFailurePolicy declaration = case rsFailurePolicy declaration of-      SelectionAck -> selectionFailure (rsFailurePolicyLoc declaration) SelectionFailureAckForbidden "selection failure cannot acknowledge the source message"+    checkFailurePolicy declaration = case (.failurePolicy) declaration of+      SelectionAck -> selectionFailure ((.failurePolicyLoc) declaration) SelectionFailureAckForbidden "selection failure cannot acknowledge the source message"       SelectionRetry -> Right CheckedFailureRetry       SelectionDeadLetter -> Right CheckedFailureDeadLetter       SelectionHalt -> Right CheckedFailureHalt      checkQuery declaration = do-      readModel <- case find ((== rsQuery declaration) . rmName) readModels of-        Nothing -> selectionFailure (rsQueryLoc declaration) SelectionQueryUnknown ("selection query names undeclared readmodel '" <> rsQuery declaration <> "'")+      readModel <- case find ((== (.query) declaration) . (.name)) readModels of+        Nothing -> selectionFailure ((.queryLoc) declaration) SelectionQueryUnknown ("selection query names undeclared readmodel '" <> (.query) declaration <> "'")         Just value -> Right value-      queryTypesDeclaration <- maybe (selectionFailure (rsQueryLoc declaration) SelectionQueryContractMissing ("readmodel '" <> rmName readModel <> "' has no typed query input/result contract")) Right (queryTypes readModel)-      if rsQueryInput declaration == "input"+      queryTypesDeclaration <- maybe (selectionFailure ((.queryLoc) declaration) SelectionQueryContractMissing ("readmodel '" <> (.name) readModel <> "' has no typed query input/result contract")) Right ((.queryTypes) readModel)+      if (.queryInput) declaration == "input"         then pure ()-        else selectionFailure (rsQueryInputLoc declaration) SelectionQueryInputBindingInvalid "selection query input must be the router input binding `input`"-      queryInput <- liftTypeGraph (rsQueryLoc declaration) (resolveTypeExpression graph ("readmodel " <> rmName readModel <> " query input") (inputLoc queryTypesDeclaration) (input queryTypesDeclaration))-      queryResult <- liftTypeGraph (rsQueryLoc declaration) (resolveTypeExpression graph ("readmodel " <> rmName readModel <> " query result") (resultLoc queryTypesDeclaration) (result queryTypesDeclaration))-      routerInputExpression <- maybe (selectionFailure (inLoc (rtInput router)) SelectionQueryInputBindingInvalid "declarative router input must name its mapped query-input type with `input Name : Type`") Right (inType (rtInput router))-      routerInput <- liftTypeGraph (inLoc (rtInput router)) (resolveTypeExpression graph ("router " <> rtId router <> " input") (inLoc (rtInput router)) routerInputExpression)+        else selectionFailure ((.queryInputLoc) declaration) SelectionQueryInputBindingInvalid "selection query input must be the router input binding `input`"+      queryInput <- liftTypeGraph ((.queryLoc) declaration) (resolveTypeExpression graph ("readmodel " <> (.name) readModel <> " query input") ((.inputLoc) queryTypesDeclaration) ((.input) queryTypesDeclaration))+      queryResult <- liftTypeGraph ((.queryLoc) declaration) (resolveTypeExpression graph ("readmodel " <> (.name) readModel <> " query result") ((.resultLoc) queryTypesDeclaration) ((.result) queryTypesDeclaration))+      routerInputExpression <- maybe (selectionFailure ((.loc) ((.input) router)) SelectionQueryInputBindingInvalid "declarative router input must name its mapped query-input type with `input Name : Type`") Right ((.valueType) ((.input) router))+      routerInput <- liftTypeGraph ((.loc) ((.input) router)) (resolveTypeExpression graph ("router " <> (.id) router <> " input") ((.loc) ((.input) router)) routerInputExpression)       if routerInput == queryInput         then pure ()-        else selectionFailure (inLoc (rtInput router)) SelectionQueryInputTypeMismatch ("router input type does not match readmodel '" <> rmName readModel <> "' query input")-      _ <- structuralRecord (inLoc (rtInput router)) SelectionQueryInputBindingInvalid "router query input" routerInput+        else selectionFailure ((.loc) ((.input) router)) SelectionQueryInputTypeMismatch ("router input type does not match readmodel '" <> (.name) readModel <> "' query input")+      _ <- structuralRecord ((.loc) ((.input) router)) SelectionQueryInputBindingInvalid "router query input" routerInput       rowBinding <- case queryResult of-        RList rowType -> structuralRecord (resultLoc queryTypesDeclaration) SelectionQueryRowNotStructural "query result row" rowType-        _ -> selectionFailure (resultLoc queryTypesDeclaration) SelectionQueryResultNotList "declarative router query result must be List Row"+        RList rowType -> structuralRecord ((.resultLoc) queryTypesDeclaration) SelectionQueryRowNotStructural "query result row" rowType+        _ -> selectionFailure ((.resultLoc) queryTypesDeclaration) SelectionQueryResultNotList "declarative router query result must be List Row"       pure-        ( CheckedReadModelQuery (rmName readModel) queryInput queryResult,+        ( CheckedReadModelQuery ((.name) readModel) queryInput queryResult,           CheckedMappedExpr SelectionInput queryInput,           rowBinding         )      structuralRecord diagnosticLoc diagnosticCode owner = \case-      RRef key -> case Map.lookup key (tgDeclarations graph) of+      RRef key -> case Map.lookup key ((.declarations) graph) of         Just (ResolvedStructural _ (RRecord constructor _ fields)) -> Right (CheckedMappedType key constructor fields)         _ -> selectionFailure diagnosticLoc diagnosticCode (owner <> " must be a mapped structural record")       _ -> selectionFailure diagnosticLoc diagnosticCode (owner <> " must be a mapped structural record") -    resolveTargetCommand = case [aggregate | NAggregate aggregate <- specNodes spec, aggName aggregate == rtTarget router] of-      [aggregate] -> case [command | command <- aggCommands aggregate, cmdName command == rdCommand (rtDispatch router)] of+    resolveTargetCommand = case [aggregate | NAggregate aggregate <- (.nodes) spec, (.name) aggregate == (.target) router] of+      [aggregate] -> case [command | command <- (.commands) aggregate, (.name) command == (.command) ((.dispatch) router)] of         [command] -> Right (aggregate, command)-        _ -> selectionFailure (rdLoc (rtDispatch router)) SelectionCommandUnknown ("target aggregate '" <> rtTarget router <> "' has no unique command '" <> rdCommand (rtDispatch router) <> "'")-      _ -> selectionFailure (rtLoc router) SelectionTargetAmbiguous ("declarative router target '" <> rtTarget router <> "' does not identify exactly one aggregate")+        _ -> selectionFailure ((.loc) ((.dispatch) router)) SelectionCommandUnknown ("target aggregate '" <> (.target) router <> "' has no unique command '" <> (.command) ((.dispatch) router) <> "'")+      _ -> selectionFailure ((.loc) router) SelectionTargetAmbiguous ("declarative router target '" <> (.target) router <> "' does not identify exactly one aggregate")      checkCommandMappings selectionGraph inputBinding rowBinding aggregate command = do-      let bindings = rdFields (rtDispatch router)-          duplicateNames = duplicates (map fbName bindings)-          expectedNames = sort (map aggregateFieldName (cmdFields command))-          actualNames = sort (map fbName bindings)+      let bindings = (.fields) ((.dispatch) router)+          duplicateNames = duplicates (map (.name) bindings)+          expectedNames = sort (map (.name) ((.fields) command))+          actualNames = sort (map (.name) bindings)       case duplicateNames of-        duplicateName : _ -> selectionFailure (rdLoc (rtDispatch router)) SelectionCommandMappingDuplicate ("dispatch field '" <> duplicateName <> "' is mapped more than once")+        duplicateName : _ -> selectionFailure ((.loc) ((.dispatch) router)) SelectionCommandMappingDuplicate ("dispatch field '" <> duplicateName <> "' is mapped more than once")         [] -> pure ()       if expectedNames == actualNames         then pure ()-        else selectionFailure (rdLoc (rtDispatch router)) SelectionCommandMappingIncomplete ("dispatch mapping must bind every field of command '" <> cmdName command <> "' exactly once")-      Map.fromList <$> traverse (checkBinding selectionGraph inputBinding rowBinding aggregate bindings) (cmdFields command)+        else selectionFailure ((.loc) ((.dispatch) router)) SelectionCommandMappingIncomplete ("dispatch mapping must bind every field of command '" <> (.name) command <> "' exactly once")+      Map.fromList <$> traverse (checkBinding selectionGraph inputBinding rowBinding aggregate bindings) ((.fields) command)      checkBinding selectionGraph inputBinding rowBinding aggregate bindings field = do-      binding <- case find ((== aggregateFieldName field) . fbName) bindings of+      binding <- case find ((== (.name) field) . (.name)) bindings of         Just value -> Right value-        Nothing -> selectionFailure (rdLoc (rtDispatch router)) SelectionCommandMappingIncomplete ("missing dispatch mapping for field '" <> aggregateFieldName field <> "'")-      expression <- resolveBinding selectionGraph inputBinding rowBinding (rdLoc (rtDispatch router)) binding+        Nothing -> selectionFailure ((.loc) ((.dispatch) router)) SelectionCommandMappingIncomplete ("missing dispatch mapping for field '" <> (.name) field <> "'")+      expression <- resolveBinding selectionGraph inputBinding rowBinding ((.loc) ((.dispatch) router)) binding       expectedAggregateType <- case inferAggregateFieldType symbols aggregate CommandFieldUse field of-        Left _ -> selectionFailure (aggregateFieldLoc field) SelectionCommandMappingTypeMismatch ("command field '" <> aggregateFieldName field <> "' has no selection-compatible scalar type")+        Left _ -> selectionFailure ((.loc) field) SelectionCommandMappingTypeMismatch ("command field '" <> (.name) field <> "' has no selection-compatible scalar type")         Right value -> Right value-      expected <- maybe (selectionFailure (aggregateFieldLoc field) SelectionCommandMappingTypeMismatch ("command field '" <> aggregateFieldName field <> "' is not a supported scalar selection target")) Right (selectionTypeFromAggregate expectedAggregateType)-      requireScalarType (checkedScalarLoc expression) SelectionCommandMappingTypeMismatch ("command field '" <> aggregateFieldName field <> "'") expected expression-      pure (aggregateFieldName field, expression)+      expected <- maybe (selectionFailure ((.loc) field) SelectionCommandMappingTypeMismatch ("command field '" <> (.name) field <> "' is not a supported scalar selection target")) Right (selectionTypeFromAggregate expectedAggregateType)+      requireScalarType ((.loc) expression) SelectionCommandMappingTypeMismatch ("command field '" <> (.name) field <> "'") expected expression+      pure ((.name) field, expression)      queryUseSites queryName =       [ useSite-      | useSite <- tgUseSites graph,+      | useSite <- (.useSites) graph,         case useSite of           RootReadModelQueryInput name _ -> name == queryName           RootReadModelQueryResult name _ -> name == queryName           _ -> False       ] -    readModels = [readModel | NReadModel readModel <- specNodes spec]+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]  resolveBinding :: TypeGraph -> CheckedMappedExpr -> CheckedMappedType -> Loc -> FieldBinding -> Either (NonEmpty RouterSelectionDiagnostic) CheckedScalarExpr resolveBinding graph inputBinding rowBinding diagnosticLoc binding =-  resolveSelectionExpr graph (checkedMappedExprType inputBinding) rowBinding Nothing expression+  resolveSelectionExpr graph ((.valueType) inputBinding) rowBinding Nothing expression   where-    expression = case fbValue binding of-      Nothing -> EPath diagnosticLoc UnqualifiedRoot ["input", fbName binding]+    expression = case (.value) binding of+      Nothing -> EPath diagnosticLoc UnqualifiedRoot ["input", (.name) binding]       Just value         | Just literal <- quotedValue value -> ELiteral diagnosticLoc (LiteralText literal)         | otherwise -> EPath diagnosticLoc UnqualifiedRoot (T.splitOn "." value)@@ -361,7 +385,7 @@   EPath loc UnqualifiedRoot (rootName : fields) -> do     (root, rootType) <- case rootName of       "input" -> Right (SelectionInput, inputType)-      "row" -> Right (SelectionRow, RRef (checkedMappedTypeKey rowType))+      "row" -> Right (SelectionRow, RRef ((.key) rowType))       _ -> selectionFailure loc SelectionExpressionRootUnknown ("selection expression root must be input or row, found '" <> rootName <> "'")     if null fields       then selectionFailure loc SelectionExpressionTypeMismatch "a whole mapped value is not a scalar expression"@@ -404,18 +428,18 @@       (checkedLeft, checkedRight) <- case left of         ELiteral _ LiteralIntegral {} -> do           rightValue <- resolveSelectionExpr graph inputType rowType Nothing right-          leftValue <- resolveSelectionExpr graph inputType rowType (Just (checkedScalarType rightValue)) left+          leftValue <- resolveSelectionExpr graph inputType rowType (Just ((.valueType) rightValue)) left           pure (leftValue, rightValue)         _ -> do           leftValue <- resolveSelectionExpr graph inputType rowType Nothing left-          rightValue <- resolveSelectionExpr graph inputType rowType (Just (checkedScalarType leftValue)) right+          rightValue <- resolveSelectionExpr graph inputType rowType (Just ((.valueType) leftValue)) right           pure (leftValue, rightValue)-      if checkedScalarType checkedLeft == checkedScalarType checkedRight+      if (.valueType) checkedLeft == (.valueType) checkedRight         then pure ()         else selectionFailure (exprLoc expression) SelectionExpressionTypeMismatch "comparison operands have different scalar types"-      if comparisonAdmitted operator (checkedScalarType checkedLeft)+      if comparisonAdmitted operator ((.valueType) checkedLeft)         then pure ()-        else selectionFailure (exprLoc expression) SelectionOperatorUnsupported ("comparison operator is not admitted for " <> scalarTypeText (checkedScalarType checkedLeft))+        else selectionFailure (exprLoc expression) SelectionOperatorUnsupported ("comparison operator is not admitted for " <> scalarTypeText ((.valueType) checkedLeft))       requireExpected (exprLoc expression) expected SelectionBool       pure (CheckedScalarExpr SelectionBool (CheckedCompare operator checkedLeft checkedRight) (exprLoc expression)) @@ -428,16 +452,16 @@       [] -> case selectionTypeFromResolved currentType of         Just scalarType -> Right (scalarType, reverse segments)         Nothing -> selectionFailure diagnosticLoc SelectionExpressionTypeMismatch "selection path does not end at a supported scalar"-      fieldName : rest -> case currentType of-        RRef owner -> case Map.lookup owner (tgDeclarations graph) of-          Just (ResolvedStructural _ (RRecord _ _ fields)) -> case find ((== fieldName) . rwfHaskell) fields of-            Nothing -> selectionFailure diagnosticLoc SelectionExpressionFieldUnknown ("mapped record '" <> unMappedKey owner <> "' has no field '" <> fieldName <> "'")+      name : rest -> case currentType of+        RRef owner -> case Map.lookup owner ((.declarations) graph) of+          Just (ResolvedStructural _ (RRecord _ _ fields)) -> case find ((== name) . (.haskell)) fields of+            Nothing -> selectionFailure diagnosticLoc SelectionExpressionFieldUnknown ("mapped record '" <> unMappedKey owner <> "' has no field '" <> name <> "'")             Just field-              | rwfPresence field /= PRequired -> selectionFailure diagnosticLoc SelectionExpressionFieldOptional ("field '" <> fieldName <> "' is optional; selection paths must be total")-              | ROptional {} <- rwfType field -> selectionFailure diagnosticLoc SelectionExpressionFieldOptional ("field '" <> fieldName <> "' is nullable; selection paths must be total")-              | otherwise -> go (CheckedSelectionPathSegment fieldName (rwfKey field) owner : segments) (rwfType field) rest+              | (.presence) field /= PRequired -> selectionFailure diagnosticLoc SelectionExpressionFieldOptional ("field '" <> name <> "' is optional; selection paths must be total")+              | ROptional {} <- (.valueType) field -> selectionFailure diagnosticLoc SelectionExpressionFieldOptional ("field '" <> name <> "' is nullable; selection paths must be total")+              | otherwise -> go (CheckedSelectionPathSegment name ((.key) field) owner : segments) ((.valueType) field) rest           _ -> selectionFailure diagnosticLoc SelectionQueryRowNotStructural ("mapped type '" <> unMappedKey owner <> "' is not a structural record")-        _ -> selectionFailure diagnosticLoc SelectionExpressionFieldUnknown ("cannot project field '" <> fieldName <> "' through a scalar value")+        _ -> selectionFailure diagnosticLoc SelectionExpressionFieldUnknown ("cannot project field '" <> name <> "' through a scalar value")  requirePositive :: Loc -> RouterSelectionDiagnosticCode -> Text -> Natural -> Either (NonEmpty RouterSelectionDiagnostic) Natural requirePositive diagnosticLoc diagnosticCode owner value@@ -457,8 +481,8 @@  requireScalarType :: Loc -> RouterSelectionDiagnosticCode -> Text -> SelectionScalarType -> CheckedScalarExpr -> Either (NonEmpty RouterSelectionDiagnostic) () requireScalarType diagnosticLoc diagnosticCode owner expected expression-  | checkedScalarType expression == expected = Right ()-  | otherwise = selectionFailure diagnosticLoc diagnosticCode (owner <> " must have type " <> scalarTypeText expected <> ", found " <> scalarTypeText (checkedScalarType expression))+  | (.valueType) expression == expected = Right ()+  | otherwise = selectionFailure diagnosticLoc diagnosticCode (owner <> " must have type " <> scalarTypeText expected <> ", found " <> scalarTypeText ((.valueType) expression))  liftTypeGraph :: Loc -> Either TypeGraphError value -> Either (NonEmpty RouterSelectionDiagnostic) value liftTypeGraph diagnosticLoc = either (\err -> selectionFailure diagnosticLoc SelectionExpressionTypeMismatch ("mapped type could not be resolved: " <> T.pack (show err))) Right@@ -525,26 +549,26 @@ canonicalSelection selection =   tuple     [ atom "keiro-dsl/router-selection/1",-      atom (checkedQueryName (checkedQuery selection)),-      canonicalResolvedType (checkedQueryInputType (checkedQuery selection)),-      canonicalResolvedType (checkedQueryResultType (checkedQuery selection)),-      canonicalScalar (checkedKey selection),-      canonicalScalar (checkedPredicate selection),-      canonicalScalar (checkedRecipient selection),-      tuple [tuple [atom fieldName, canonicalScalar expression] | (fieldName, expression) <- Map.toAscList (checkedCommandFields selection)],-      atom (checkedTarget selection),-      atom (checkedCommand selection),-      atom (T.pack (show (checkedLimit selection))),+      atom ((.name) ((.query) selection)),+      canonicalResolvedType ((.inputType) ((.query) selection)),+      canonicalResolvedType ((.resultType) ((.query) selection)),+      canonicalScalar ((.key) selection),+      canonicalScalar ((.predicate) selection),+      canonicalScalar ((.recipient) selection),+      tuple [tuple [atom name, canonicalScalar expression] | (name, expression) <- Map.toAscList ((.commandFields) selection)],+      atom ((.target) selection),+      atom ((.command) selection),+      atom (T.pack (show ((.limit) selection))),       atom "order:target-stream",       atom "dedupe:target-stream",-      atom ("empty:" <> T.pack (show (checkedEmptyPolicy selection))),-      atom ("failure:" <> T.pack (show (checkedFailurePolicy selection))),+      atom ("empty:" <> T.pack (show ((.emptyPolicy) selection))),+      atom ("failure:" <> T.pack (show ((.failurePolicy) selection))),       atom "redelivery:stable-union",       atom "partial:retain-successes"     ]  canonicalScalar :: CheckedScalarExpr -> Text-canonicalScalar expression = tuple [atom (scalarTypeText (checkedScalarType expression)), node (checkedScalarNode expression)]+canonicalScalar expression = tuple [atom (scalarTypeText ((.valueType) expression)), node ((.node) expression)]   where     node = \case       CheckedPath root segments -> tuple (atom (T.pack (show root)) : map segment segments)@@ -554,7 +578,7 @@       CheckedCompare operator left right -> tuple [atom (T.pack (show operator)), canonicalScalar left, canonicalScalar right]       CheckedAnd left right -> tuple [atom "and", canonicalScalar left, canonicalScalar right]       CheckedOr left right -> tuple [atom "or", canonicalScalar left, canonicalScalar right]-    segment value = tuple [atom (unMappedKey (checkedPathOwner value)), atom (checkedPathField value), atom (checkedPathWireKey value)]+    segment value = tuple [atom (unMappedKey ((.owner) value)), atom ((.field) value), atom ((.wireKey) value)]  canonicalResolvedType :: ResolvedTypeExpr -> Text canonicalResolvedType = \case

src/Keiro/Dsl/RuntimePackage.hs view

@@ -2,6 +2,7 @@ -- generated Keiro modules. module Keiro.Dsl.RuntimePackage   ( RuntimePackageName (..),+    unRuntimePackageName,     mkRuntimePackageName,     isCabalPackageName,   )@@ -17,6 +18,9 @@   { unRuntimePackageName :: Text   }   deriving stock (Eq, Ord, Show)++unRuntimePackageName :: RuntimePackageName -> Text+unRuntimePackageName (RuntimePackageName value) = value  -- | Validate and construct an explicit runtime package name. mkRuntimePackageName :: Text -> Either Text RuntimePackageName

src/Keiro/Dsl/Scaffold.hs view

@@ -99,8731 +99,8760 @@     generatedBanner,     generatedBannerFor,     isGeneratedBannerLine,-    stampGeneratedModule,-    stampGeneratedModules,-  )-where--import Data.Char (isAlpha, isAlphaNum, isDigit, isUpper)-import Data.List (find, groupBy, isSuffixOf, nub, sort, sortOn)-import Data.List.NonEmpty (NonEmpty)-import Data.List.NonEmpty qualified as NE-import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe, maybeToList)-import Data.Set qualified as Set-import Data.Text (Text)-import Data.Text qualified as T-import Data.Version (showVersion)-import Keiro.Dsl.AggregateGenerationPlan-import Keiro.Dsl.AggregateType-import Keiro.Dsl.BehaviorCoverage qualified as Behavior-import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource-import Keiro.Dsl.CodecCompare (BranchArm (..), BranchField (..), BranchSchema (..))-import Keiro.Dsl.ConsumerTypePlan-import Keiro.Dsl.EventOutput-import Keiro.Dsl.ExplainBindings (BindingObligation (..), BindingObligationKind (..), bindingObligations, bindingObligationsForService)-import Keiro.Dsl.Expression-import Keiro.Dsl.FieldIdentity-import Keiro.Dsl.FoldFingerprint (aggregateFoldFingerprintForService, renderFoldSurfaceError)-import Keiro.Dsl.GeneratedHaskellLanguage-import Keiro.Dsl.Grammar-import Keiro.Dsl.HaskellImport-import Keiro.Dsl.HaskellName qualified as HaskellName-import Keiro.Dsl.IdDomain (IdDomainContract, contractIdDomainContractFor, idDomainContractFor, idDomainPrefix, idDomainSampleText)-import Keiro.Dsl.LanguageVersion (SourceLanguage (LegacyUnversioned), languageVersionText)-import Keiro.Dsl.MappedCodecPlan-import Keiro.Dsl.NominalType-import Keiro.Dsl.PrettyPrint (renderExpr)-import Keiro.Dsl.ProjectionMappedImpact (projectionAggregateSourceFingerprint, projectionAggregateSourceFingerprintForService)-import Keiro.Dsl.ProjectionSupply-import Keiro.Dsl.ReadModelShape (fnv1a64, registryNameFor, subscriptionNameFor)-import Keiro.Dsl.RouterSelection-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedProjectionSupplies, checkedSpec, checkedTypeGraph, effectiveContractLanguageVersion, effectiveLanguageContract, legacyCheckedService)-import Keiro.Dsl.SourceIndex qualified as SourceIndex-import Keiro.Dsl.TypeGraph-import Keiro.Dsl.Validate (sagaCategoryError)-import Paths_keiro_dsl qualified as Package-import Text.Read (readMaybe)---- | One emitted module: its on-disk path (relative to the scaffold @--out@--- directory), its full text, and whether it is overwritten every run--- ('Generated') or written only when absent ('HoleStub').-data ScaffoldModule = ScaffoldModule-  { modulePath :: !FilePath,-    moduleText :: !Text,-    kind :: !ModuleKind,-    origin :: !Text-  }-  deriving stock (Eq, Show)---- | Stable semantic identity for a generated artifact.  It is deliberately--- independent of the cased module path: source-name migrations pair artifacts--- by this role, then compare their old and current paths.-data ModuleRole = ModuleRole-  { roleOwnerKind :: !Text,-    roleOwnerName :: !Text,-    roleFamily :: !Text-  }-  deriving stock (Eq, Ord, Show)--moduleRole :: ScaffoldModule -> ModuleRole-moduleRole scaffoldModule =-  ModuleRole-    { roleOwnerKind = headOr "module" originWords,-      roleOwnerName = origin scaffoldModule,-      roleFamily = case reverse (T.splitOn "." moduleName) of-        family : _ -> family-        [] -> moduleName-    }-  where-    originWords = T.words (origin scaffoldModule)-    moduleName = T.replace "/" "." (T.dropEnd 3 (T.pack (modulePath scaffoldModule)))-    headOr fallback = \case-      value : _ -> value-      [] -> fallback--data ModuleKind-  = -- | @-- \@generated@; overwritten on every scaffold.-    Generated-  | -- | Hand-owned; created only when absent, never overwritten.-    HoleStub-  deriving stock (Eq, Show)---- | The threading context: the spec's @context@ name, the chosen output--- module-namespace root, and the placement style. Extended additively (never--- re-shaped) by later verticals.-data Context = Context-  { contextName :: !Text,-    -- | @""@ means no namespace prefix (the historical default).-    moduleRoot :: !Text,-    -- | 'GeneratedPrefix' is the historical default.-    placement :: !Placement-  }-  deriving stock (Eq, Show)---- | One aggregate-level reason a generated nominal declaration must be visible.--- The declaration itself is context-owned; these use sites determine the--- aggregate modules that import it.-data NominalUseSite = NominalUseSite-  { nominalUseAggregate :: !Name,-    nominalUseKind :: !AggregateUseSite-  }-  deriving stock (Eq, Ord, Show)---- | The checked generation owner for one unbound ID or enum. Every owner in a--- service points at the same context-level module, while retaining its source--- location through 'ResolvedNominalType' and all aggregate use sites explicitly.-data NominalGenerationOwner = NominalGenerationOwner-  { nominalDeclaration :: !ResolvedNominalType,-    nominalModule :: !Text,-    nominalUseSites :: !(Set.Set NominalUseSite),-    nominalEqualityUsed :: !Bool-  }-  deriving stock (Eq, Show)---- | A context with today's default placement ('GeneratedPrefix', no root prefix)--- for the given @context@ name. Callers that do not care about placement (the--- @parse@ path, tests) build their context with this.-defaultContext :: Text -> Context-defaultContext name = Context {contextName = name, moduleRoot = "", placement = GeneratedPrefix}---- | The generated-layer namespace for a node, honouring the root prefix and the--- placement style. The 'Text' argument is the already-pascalised node name (e.g.--- @Reservation@, @HospitalSurge@). For 'GeneratedPrefix' this is--- @\<root\>.Generated.\<Ctx\>.\<Node\>@ (identical to the historical layout); for--- 'CollocatedLeaf' it is @\<root\>.\<Ctx\>.\<Node\>.Generated@.-genPrefixFor :: Context -> Text -> Text-genPrefixFor ctx node = case placement ctx of-  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> "." <> node-  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> "." <> node <> ".Generated"---- | The generated-layer namespace shared by modules emitted once for a whole--- service context, such as Nominals, ReplayAudit, and Conformance.-contextGeneratedPrefix :: Context -> Text-contextGeneratedPrefix ctx = case placement ctx of-  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx-  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated"---- | The hand-owned (hole) namespace for a node: @\<root\>.\<Ctx\>.\<Node\>@ —--- the same for both placement styles (holes always sit beside the domain).-holePrefixFor :: Context -> Text -> Text-holePrefixFor ctx node = rootPrefix ctx <> ctxPascalOf ctx <> "." <> node---- | The one context-level Haskell owner for generated IDs and enums.-generatedNominalModule :: Context -> Text-generatedNominalModule ctx = contextGeneratedPrefix ctx <> ".Nominals"---- | Emit the one context-owned table that contains every current behavior--- source position. Services without behavior requirements emit no table and,--- consequently, no aggregate behavior contract imports one.-behaviorSourceMapModule :: Context -> [BehaviorSource.BehaviorSourceEntry] -> Maybe ScaffoldModule-behaviorSourceMapModule _ [] = Nothing-behaviorSourceMapModule ctx entries =-  Just-    ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-        moduleText =-          nl-            ( renderGeneratedLanguagePragmas []-                <> [ generatedBanner,-                     "module " <> moduleName,-                     "  ( BehaviorSourceLocation (..)",-                     "  , behaviorSourceLocation",-                     "  , renderBehaviorSourceLocation",-                     "  ) where",-                     "",-                     "import Data.Text (Text)",-                     "import Data.Text qualified as T",-                     "",-                     "data BehaviorSourceLocation = BehaviorSourceLocation",-                     "  { sourceFile :: !FilePath",-                     "  , sourceLine :: !Int",-                     "  , sourceColumn :: !Int",-                     "  }",-                     "  deriving stock (Eq, Ord, Show)",-                     "",-                     "behaviorSourceLocation :: Text -> Maybe BehaviorSourceLocation",-                     "behaviorSourceLocation key = case key of"-                   ]-                <> [ "  "-                       <> tshow (Behavior.unBehaviorKey (BehaviorSource.behaviorSourceKey entry))-                       <> " -> Just (BehaviorSourceLocation "-                       <> tshow (T.pack (BehaviorSource.behaviorSourceFile entry))-                       <> " "-                       <> tshow' (BehaviorSource.behaviorSourceLine entry)-                       <> " "-                       <> tshow' (BehaviorSource.behaviorSourceColumn entry)-                       <> ")"-                   | entry <- sortOn BehaviorSource.behaviorSourceKey entries-                   ]-                <> [ "  _ -> Nothing",-                     "",-                     "renderBehaviorSourceLocation :: Text -> Text",-                     "renderBehaviorSourceLocation key = case behaviorSourceLocation key of",-                     "  Just location -> T.pack (sourceFile location) <> \":\" <> tshow (sourceLine location) <> \":\" <> tshow (sourceColumn location)",-                     "  Nothing -> \"<internal invariant: missing behavior source for \" <> key <> \">\"",-                     "",-                     "tshow :: Show value => value -> Text",-                     "tshow = T.pack . show"-                   ]-            ),-        kind = Generated,-        origin = "context " <> contextName ctx <> " behavior source map"-      }-  where-    moduleName = contextGeneratedPrefix ctx <> ".BehaviorSourceMap"---- | The root namespace prefix, dot-terminated, or @""@ when no root is set.-rootPrefix :: Context -> Text-rootPrefix ctx = case moduleRoot ctx of r | T.null r -> ""; r -> r <> "."---- | The context name in PascalCase, e.g. @hospital-capacity@ -> @HospitalCapacity@.-ctxPascalOf :: Context -> Text-ctxPascalOf = pascalFromKebab . contextName------------------------------------------------------------------------------------- Firewall self-check (M3)------------------------------------------------------------------------------------- | The canonical keiki surface forbidden in generated modules. Symbolic--- operators are matched as maximal Haskell symbol tokens, identifiers as complete--- tokens, qualifiers by their leading module alias, and imports structurally.-data FirewallSurface = FirewallSurface-  { forbiddenSymbolic :: ![Text],-    forbiddenIdents :: ![Text],-    forbiddenQualifiers :: ![Text],-    forbiddenImports :: ![Text],-    restrictedImports :: ![(Text, [Text])]-  }-  deriving stock (Eq, Show)--firewallSurface :: FirewallSurface-firewallSurface =-  FirewallSurface-    { forbiddenSymbolic = [".==", "./=", ".<", ".<=", ".>", ".>=", ".&&", ".||", ".+", ".-", ".*", "=:", "*:"],-      forbiddenIdents = ["lit", "pnot", "tadd", "tsub", "tmul"],-      forbiddenQualifiers = ["B"],-      forbiddenImports = ["Keiki.Builder", "Keiki.Operators", "Keiki.Symbolic"],-      -- Generated aggregate modules use the first two names; generated-      -- harnesses validate, step, and replay filled holes register by register.-      restrictedImports =-        [ ( "Keiki.Core",-            [ "RegFile",-              "HsPred",-              "FieldProjection",-              "ExactFieldProjection",-              "FieldWitness",-              "fieldWitness",-              "exactFieldWitness",-              "fieldWitnessGet",-              "fieldWitnessAgrees",-              "applyEventsEither",-              "defaultValidationOptions",-              "step",-              "validateTransducer",-              "EdgeMode",-              "EdgeRef",-              "StepSuccess",-              "StepFailure",-              "ReplayEventSpan",-              "ReplayAttribution",-              "ReplaySuccess",-              "applyEventsDetailedEither",-              "stepDetailedEither",-              "!"-            ]-          )-        ]-    }---- | Scan generated modules for firewall breaches, returning every offending--- @(module path, token, 1-based line number)@. Only modules whose 'kind' is--- 'Generated' are scanned. Strings and comments are skipped, symbol runs use--- maximal munch, and keiki imports are checked independently of token spelling.-firewallBreaches :: [ScaffoldModule] -> [(FilePath, Text, Int)]-firewallBreaches mods =-  [ (modulePath m, breach, n)-  | m <- mods,-    kind m == Generated,-    not (authoritativeScalarModule m),-    (n, line) <- zip [1 ..] (T.lines (moduleText m)),-    breach <- lineBreaches line-  ]---- The version-2 aggregate transducer and an outcome-enabled aggregate event--- stream are the narrow, intentional exceptions to the generated--- symbolic-operator firewall. The former owns transition terms; the latter--- evaluates a checked reason term only after Keiki has selected an exact edge.--- Ordinary event-stream modules remain scanned.-authoritativeScalarModule :: ScaffoldModule -> Bool-authoritativeScalarModule scaffoldModule =-  "/Transducer.hs" `isSuffixOf` path-    || ( "/EventStream.hs" `isSuffixOf` path-           && "DomainCommandHandler" `T.isInfixOf` moduleText scaffoldModule-       )-  where-    path = modulePath scaffoldModule--lineBreaches :: Text -> [Text]-lineBreaches line = case importModule line of-  Just _ -> importBreaches line-  Nothing -> tokenBreaches (codeTokens line)-  where-    tokenBreaches = mapMaybe breachFor-    breachFor (IdentToken ident)-      | ident `elem` forbiddenIdents firewallSurface = Just ident-    breachFor (QualifiedToken qualifier)-      | qualifier `elem` forbiddenQualifiers firewallSurface = Just (qualifier <> ".*")-    breachFor (SymbolToken symbol)-      | symbol `elem` forbiddenSymbolic firewallSurface = Just symbol-    breachFor _ = Nothing--data CodeToken = IdentToken !Text | QualifiedToken !Text | SymbolToken !Text--codeTokens :: Text -> [CodeToken]-codeTokens = go . T.unpack-  where-    go [] = []-    go ('-' : '-' : _) = []-    go ('"' : rest) = go (dropString rest)-    go ('\'' : rest) = go (dropChar rest)-    go (c : rest)-      | isIdentStart c =-          let (identTail, afterIdent) = span isIdentContinue rest-              ident = T.pack (c : identTail)-           in case afterIdent of-                '.' : next : more-                  | isUpper c && isIdentStart next ->-                      let (_member, afterMember) = span isIdentContinue more-                       in QualifiedToken ident : go afterMember-                _ -> IdentToken ident : go afterIdent-      | isSymbolChar c =-          let (symbolTail, afterSymbol) = span isSymbolChar rest-           in SymbolToken (T.pack (c : symbolTail)) : go afterSymbol-      | otherwise = go rest-    isIdentStart c = isAlpha c || c == '_'-    isIdentContinue c = isAlphaNum c || c == '_' || c == '\''-    isSymbolChar c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)-    dropString [] = []-    dropString ('\\' : _escaped : rest) = dropString rest-    dropString ('"' : rest) = rest-    dropString (_ : rest) = dropString rest-    dropChar [] = []-    dropChar ('\\' : _escaped : rest) = dropChar rest-    dropChar ('\'' : rest) = rest-    dropChar (_ : rest) = dropChar rest--importBreaches :: Text -> [Text]-importBreaches line = case importModule line of-  Nothing -> []-  Just imported-    | imported `elem` forbiddenImports firewallSurface -> ["import:" <> imported]-    | Just allowed <- lookup imported (restrictedImports firewallSurface),-      not (hasAllowedExplicitImportList allowed line) ->-        ["import:" <> imported]-    | otherwise -> []--importModule :: Text -> Maybe Text-importModule line = case T.words (T.strip line) of-  "import" : rest -> find (T.isPrefixOf "Keiki.") rest-  _ -> Nothing--hasAllowedExplicitImportList :: [Text] -> Text -> Bool-hasAllowedExplicitImportList allowed line =-  case (T.breakOn "(" line, T.breakOnEnd ")" line) of-    ((_, open), (close, _))-      | not (T.null open) && not (T.null close) ->-          let inside = T.takeWhile (/= ')') (T.drop 1 open)-              names = filter (not . T.null) (T.split (not . isAlphaNum) inside)-           in all (`elem` allowed) names-    _ -> False------------------------------------------------------------------------------------- Derived naming------------------------------------------------------------------------------------- | Resolved, denormalized view of an aggregate used by every emitter.-data Agg = Agg-  { aContext :: !Context,-    aCheckedService :: !CheckedService,-    aLanguageContract :: !EffectiveLanguageContract,-    aSpec :: !Spec,-    aAggregate :: !Aggregate,-    aCtxPascal :: !Text,-    aName :: !Text,-    aLoc :: !Loc,-    aVertexType :: !Text,-    aIds :: ![IdDecl],-    aEnums :: ![EnumDecl],-    aRegs :: ![ResolvedRegister],-    aStates :: ![StateDecl],-    aCommands :: ![ResolvedCtor],-    aEvents :: ![ResolvedCtor],-    aDomainOutcomeTypes :: !(Maybe ResolvedDomainOutcomeTypes),-    -- | Generated IDs and enums used by this aggregate, in stable name order.-    aGeneratedNominals :: ![ResolvedNominalType],-    aTransitions :: ![Transition],-    aOutputMappings :: !(Map.Map (Int, Int) EventOutputMapping),-    aWire :: !WireSpec,-    aProjection :: !(Maybe ProjectionSpec),-    aSnapshot :: !(Maybe SnapshotSpec),-    aFoldFingerprint :: !Text,-    aReadModels :: ![ReadModelNode],-    aTypeGraph :: !(Maybe TypeGraph),-    aSymbols :: !AggregateSymbols,-    -- | e.g. @Generated.HospitalCapacity.Reservation@-    aGenPrefix :: !Text,-    -- | e.g. @HospitalCapacity.Reservation@-    aHolePrefix :: !Text-  }--data ResolvedDomainOutcomeTypes = ResolvedDomainOutcomeTypes-  { resolvedRejectionType :: !ResolvedAggregateType,-    resolvedNoOpType :: !ResolvedAggregateType-  }-  deriving stock (Eq, Show)--aggregateCheckedService :: Agg -> CheckedService-aggregateCheckedService = aCheckedService--data ResolvedRegister = ResolvedRegister-  { rrName :: !Name,-    rrType :: !ResolvedAggregateType,-    rrInitial :: !ResolvedRegisterInitial,-    rrLoc :: !Loc-  }-  deriving stock (Eq, Show)---- | A command or event constructor with its fully-resolved field identities and--- aggregate types.-data ResolvedCtor = ResolvedCtor-  { rcName :: !Text,-    -- | (DSL/selector/wire identity, canonical aggregate type)-    rcFields :: ![(ResolvedFieldIdentity, ResolvedAggregateType)],-    -- | EP-2: schema version (1 for commands and unversioned events).-    rcVersion :: !Int,-    -- | EP-2: the source version this event migrates from (the upcaster step).-    rcUpcastFrom :: !(Maybe Int)-  }--defaultWire :: WireSpec-defaultWire = WireSpec {wireKind = "ctorName", wireFields = "camelCase", wireSchemaVersion = 1}--resolveAgg :: Context -> Spec -> Aggregate -> Agg-resolveAgg ctx spec = resolveAggForService ctx (legacyCheckedService spec)---- | Resolve one aggregate under the service's effective runtime semantics.-resolveAggForService :: Context -> CheckedService -> Aggregate -> Agg-resolveAggForService ctx service agg =-  Agg-    { aContext = ctx,-      aCheckedService = service,-      aLanguageContract = checkedLanguageContract service,-      aSpec = spec,-      aAggregate = agg,-      aCtxPascal = ctxPascal,-      aName = nm,-      aLoc = aggLoc agg,-      aVertexType = vertexType,-      aIds = specIds spec,-      aEnums = specEnums spec,-      aRegs = map resolveRegister (aggRegs agg),-      aStates = aggStates agg,-      aCommands = map resolveCommand (aggCommands agg),-      aEvents = map resolveEvent (aggEvents agg),-      aDomainOutcomeTypes = resolvedDomainOutcomeTypes,-      aGeneratedNominals = generatedNominalsInTypes aggregateResolvedTypes,-      aTransitions = aggTransitions agg,-      aOutputMappings =-        Map.fromList-          [ ( (transitionIndex, emitIndex),-              orDieOutput (eventOutputMappingFromGraphResult typeGraphResult spec agg transition emitIndex eventName)-            )-          | (transitionIndex, transition) <- zip [1 ..] (aggTransitions agg),-            (emitIndex, eventName) <- zip [1 ..] (tEmits transition)-          ],-      aWire = fromMaybe defaultWire (aggWire agg),-      aProjection = aggProjection agg,-      aSnapshot = aggSnapshot agg,-      aFoldFingerprint = either (error . T.unpack . renderFoldSurfaceError) id (aggregateFoldFingerprintForService service agg),-      aReadModels = [readModel | NReadModel readModel <- specNodes spec],-      aTypeGraph = either (const Nothing) Just typeGraphResult,-      aSymbols = symbols,-      aGenPrefix = genPrefixFor ctx nm,-      aHolePrefix = holePrefixFor ctx nm-    }-  where-    spec = checkedSpec service-    nm = aggName agg-    typeGraphResult = checkedTypeGraph service-    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec-    ctxPascal = pascalFromKebab (contextName ctx)-    vertexType = nm <> "Vertex"-    commandFieldTypes = [(cmdName c, cmdFields c) | c <- aggCommands agg]-    resolveCommand c = (mkCtor CommandFieldUse (cmdName c) (cmdFields c)) {rcVersion = 1, rcUpcastFrom = Nothing}-    resolveEvent e =-      (mkCtor EventFieldUse (evName e) (eventFields e))-        { rcVersion = evVersion e,-          rcUpcastFrom = fst <$> evUpcastFrom e-        }-      where-        eventFields ev = case evBody ev of-          EventFields fs -> fs-          EventFromCommand cn -> fromMaybe [] (lookup cn commandFieldTypes)-    mkCtor useSite cn fs =-      ResolvedCtor-        { rcName = cn,-          rcFields = map (\field -> (resolveAggregateFieldIdentity field, orDie (inferAggregateFieldType symbols agg useSite field))) fs,-          rcVersion = 1,-          rcUpcastFrom = Nothing-        }-    aggregateResolvedTypes =-      map rrType (map resolveRegister (aggRegs agg))-        <> map snd (concatMap rcFields (map resolveCommand (aggCommands agg)))-        <> map snd (concatMap rcFields (map resolveEvent (aggEvents agg)))-    resolvedDomainOutcomeTypes = case aggDomainOutcomeTypes agg of-      Nothing -> Nothing-      Just declaration ->-        Just-          ResolvedDomainOutcomeTypes-            { resolvedRejectionType = resolveOutcomeType declaration (rejectionType declaration),-              resolvedNoOpType = resolveOutcomeType declaration (noOpType declaration)-            }-    resolveOutcomeType declaration name =-      orDie (resolveAggregateType symbols (outcomeTypesLoc declaration) HaskellLoweringUse (TRef name))-    resolveRegister register =-      let resolvedType = orDie (resolveAggregateType symbols (regLoc register) RegisterUse (regType register))-          resolvedInitial = orDie (resolveRegisterInitial symbols (regLoc register) resolvedType (regInitial register))-       in ResolvedRegister-            { rrName = regName register,-              rrType = resolvedType,-              rrInitial = resolvedInitial,-              rrLoc = regLoc register-            }-    orDie = either (error . ("validated aggregate resolution failed: " <>) . show) id-    orDieOutput = either (error . ("validated aggregate output resolution failed: " <>) . show) id---- | Keep only generated nominal IDs/enums from a resolved aggregate type list.--- The map both deduplicates and makes declaration/import order independent of--- member and field order.-generatedNominalsInTypes :: [ResolvedAggregateType] -> [ResolvedNominalType]-generatedNominalsInTypes resolvedTypes =-  Map.elems . Map.fromList $-    [ (resolvedNominalName nominal, nominal)-    | AggregateNominal nominal <- resolvedTypes,-      GeneratedNominal <- [resolvedNominalOwnership nominal]-    ]---- | Plan declaration ownership and use closure without emitting text. Parsing--- and validation already reject malformed declarations; retaining the checked--- error here keeps this function total for direct library callers.-planNominalGeneration :: Context -> Spec -> Either (NonEmpty NominalTypeError) [NominalGenerationOwner]-planNominalGeneration ctx spec = planNominalGenerationForService ctx (legacyCheckedService spec)--planNominalGenerationForService :: Context -> CheckedService -> Either (NonEmpty NominalTypeError) [NominalGenerationOwner]-planNominalGenerationForService ctx service = do-  registry <- resolveNominalTypes spec-  let aggregates = [resolveAggForService ctx service aggregate | NAggregate aggregate <- specNodes spec]-      generated =-        [ nominal-        | nominal <- Map.elems (nominalTypes registry),-          GeneratedNominal <- [resolvedNominalOwnership nominal]-        ]-  pure-    [ NominalGenerationOwner-        { nominalDeclaration = nominal,-          nominalModule = generatedNominalModule ctx,-          nominalUseSites = Set.fromList (concatMap (usesFor nominal) aggregates),-          nominalEqualityUsed = any (nominalEqualityUsedInGeneratedExpressions nominal) aggregates-        }-    | nominal <- generated-    ]-  where-    spec = checkedSpec service-    usesFor nominal aggregate =-      [ NominalUseSite (aName aggregate) useKind-      | useKind <- aggregateUseKinds nominal aggregate-      ]--nominalEqualityUsedInGeneratedExpressions :: ResolvedNominalType -> Agg -> Bool-nominalEqualityUsedInGeneratedExpressions nominal aggregate =-  any-    (anyTypedExpression comparesNominal)-    (resolvedGeneratedExpressions aggregate <> resolvedOutcomeExpressions aggregate)-  where-    comparesNominal expression = case typedScalarNode expression of-      TypedEqual left _ -> typedScalarType left == AggregateNominal nominal-      TypedNotEqual left _ -> typedScalarType left == AggregateNominal nominal-      _ -> False--aggregateUseKinds :: ResolvedNominalType -> Agg -> [AggregateUseSite]-aggregateUseKinds nominal aggregate =-  nub $-    [RegisterUse | nominal `elem` registerNominals]-      <> [CommandFieldUse | nominal `elem` commandNominals]-      <> [EventFieldUse | nominal `elem` eventNominals]-      <> [CodecUse | nominal `elem` eventNominals]-      <> [SnapshotUse | hasSnapshot aggregate && nominal `elem` registerNominals]-      <> [HarnessSampleUse | nominal `elem` commandNominals || nominal `elem` eventNominals]-      <> [HaskellLoweringUse | nominal `elem` (aGeneratedNominals aggregate <> outcomeNominals)]-  where-    registerNominals = generatedNominalsInTypes (map rrType (aRegs aggregate))-    commandNominals = generatedNominalsInTypes (map snd (concatMap rcFields (aCommands aggregate)))-    eventNominals = generatedNominalsInTypes (map snd (concatMap rcFields (aEvents aggregate)))-    outcomeNominals =-      generatedNominalsInTypes-        [ resolvedType-        | outcomeTypes <- maybeToList (aDomainOutcomeTypes aggregate),-          resolvedType <- [resolvedRejectionType outcomeTypes, resolvedNoOpType outcomeTypes]-        ]------------------------------------------------------------------------------------- Entry point------------------------------------------------------------------------------------- | Emit the context-level private structural stratum. Shape modules contain--- only generated wire representations. The projection facade contains only--- schema-derived Keiki field witnesses; neither layer owns consumer behavior.-scaffoldStructural :: Context -> Spec -> [ScaffoldModule]-scaffoldStructural ctx spec = scaffoldStructuralForService ctx (legacyCheckedService spec)--scaffoldStructuralForService :: Context -> CheckedService -> [ScaffoldModule]-scaffoldStructuralForService ctx service = map fst (scaffoldStructuralOwnersForService ctx service)---- | 'scaffoldStructural' paired with the mapped declarations each module was--- emitted for. A shape module names exactly one declaration; a binding skeleton--- names every declaration whose obligations it carries (several declarations may--- share one leaf binding module); the projection facade names __none__, because it--- is emitted once for the whole context from the complete resolved graph.------ This is the attribution seam whole-workspace scaffolding needs: a workspace--- emits from one merged spec, and this list says which declaration — and therefore--- which member file — produced each structural module, without parsing the--- human-readable 'origin' string.-scaffoldStructuralOwners :: Context -> Spec -> [(ScaffoldModule, [Name])]-scaffoldStructuralOwners ctx spec = scaffoldStructuralOwnersForService ctx (legacyCheckedService spec)--scaffoldStructuralOwnersForService :: Context -> CheckedService -> [(ScaffoldModule, [Name])]-scaffoldStructuralOwnersForService ctx service = case checkedTypeGraph service of-  Left _ -> []-  Right graph ->-    [(shapeModule ctx graph entry, [sdName (fst entry)]) | entry <- structural]-      <> projectionModules-      <> generatedNominalOwners ctx service-      <> nominalRepresentationOwners ctx spec-      <> nominalProjectionOwners ctx service-      <> bindingSkeletonOwnersForService ctx service graph-    where-      structural =-        [ (declaration, shape)-        | ResolvedStructural declaration shape <- Map.elems (tgDeclarations graph)-        ]-      projectionModules =-        [ ( ScaffoldModule-              { modulePath = T.unpack (T.replace "." "/" (structuralProjectionModule ctx) <> ".hs"),-                moduleText = emitStructuralProjections ctx graph,-                kind = Generated,-                origin = "context " <> specContext spec <> " mapped structural facade"-              },-            []-          )-        | not (null (projectionSpecs graph))-        ]-      spec = checkedSpec service---- | Plan one opt-in, non-production historical-codec comparison module.------ The module is intentionally absent from 'scaffoldStructural' and therefore--- from production manifests and scaffold records. It must be requested by name--- and is compiled only by consumer-owned test/tool components.-codecComparisonModule :: Context -> Spec -> Name -> Either Text ScaffoldModule-codecComparisonModule ctx spec requestedName = do-  graph <- either (Left . ("mapped type graph did not resolve: " <>) . T.pack . show) Right (resolveTypeGraph spec)-  (declaration, shape) <- case Map.lookup (MappedKey requestedName) (tgDeclarations graph) of-    Nothing -> Left ("codec comparison target is not a mapped declaration: " <> requestedName)-    Just (ResolvedOpaque _) ->-      Left-        ( "codec comparison target "-            <> requestedName-            <> " is opaque; finite evidence must never upgrade an opaque declaration to a structural claim"-        )-    Just (ResolvedStructural declaration shape) -> Right (declaration, shape)-  owner <- case sortOn aggName (comparisonOwners declaration) of-    [] ->-      Left-        ( "codec comparison target "-            <> requestedName-            <> " is not reachable from a persisted private event payload"-        )-    aggregate : _ -> Right aggregate-  let moduleName = structuralPrefix ctx <> ".CodecCompare." <> requestedName-  pure-    ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-        moduleText = emitCodecComparison ctx moduleName graph declaration shape owner,-        kind = Generated,-        origin = "non-production codec comparison " <> requestedName-      }-  where-    comparisonOwners declaration =-      [ aggregate-      | NAggregate aggregate <- specNodes spec,-        let resolved = resolveAgg ctx spec aggregate,-        any ((== sdName declaration) . mappedName) (codecMappedDeclarations resolved)-      ]-      where-        mappedName (ResolvedStructural structural _) = sdName structural-        mappedName (ResolvedOpaque opaque) = odName opaque--codecComparisonBanner :: Text-codecComparisonBanner =-  "-- @generated by keiro-dsl codec comparison; non-production migration evidence; do not edit."--emitCodecComparison :: Context -> Text -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Aggregate -> Text-emitCodecComparison ctx moduleName graph declaration shape owner =-  nl-    [ "",-      codecComparisonBanner,-      "-- This module compares historical and generated codecs in consumer-owned tests only.",-      "-- It is never a runtime fallback and never changes the generated codec's authority.",-      "module " <> moduleName <> " (compareWithHistorical) where",-      "",-      "import Control.Monad (filterM)",-      "import Data.Aeson (Value)",-      "import Data.Aeson qualified as Aeson",-      "import Data.List (sort)",-      "import Data.List.NonEmpty qualified as NonEmpty",-      "import Data.Text (Text)",-      "import Data.Text qualified",-      "import " <> codecModule <> " qualified as GeneratedCodec",-      "import Keiro.Codec.Structural (FixtureCases (..))",-      "import Keiro.Dsl.CodecCompare",-      "import Keiro.Dsl.TypeGraph (BindingVersion (..), CanonicalTypeId (..), QualifiedValueName (..))",-      "import System.Directory (doesFileExist, listDirectory)",-      "import System.FilePath (takeExtension, (</>))",-      renderPlannedImports importPlan,-      "",-      "compareWithHistorical :: HistoricalCodec " <> domainType <> " -> FilePath -> IO CompareReport",-      "compareWithHistorical historicalCodec goldenDirectory = do",-      "  names <- sort . filter ((== \".json\") . takeExtension) <$> listDirectory goldenDirectory",-      "  files <- filterM doesFileExist [goldenDirectory </> name | name <- names]",-      "  loaded <- traverse (loadGolden historicalCodec) files",-      "  let inputIssues = [issue | Left issue <- loaded]",-      "      entries = [entry | Right entry <- loaded]",-      "      typedCases = NonEmpty.toList (fixtureCases " <> fixtureReference <> ")",-      "      encodeObservations =",-      "        [ EncodeObservation label (hcEncode historicalCodec value) (GeneratedCodec.encode" <> name <> "Mapped value)",-      "        | (label, value) <- typedCases",-      "        ]",-      "      decodeObservations = [observation | (observation, _) <- entries]",-      "      typedObserved =",-      "        concat",-      "          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encode" <> name <> "Mapped value)",-      "          | (_, value) <- typedCases",-      "          ]",-      "      historicalObserved =",-      "        concat [observedBranchesFor HistoricalGolden branchSchema value | (_, values) <- entries, value <- values]",-      "      declared = declaredBranchesFor FromBinding branchSchema <> declaredBranchesFor HistoricalGolden branchSchema",-      "      provenance =",-      "        CompareProvenance",-      "          { cpHistoricalCodecIdentity = hcIdentity historicalCodec",-      "          , cpHistoricalCodecVersion = hcVersion historicalCodec",-      "          , cpCanonicalType = CanonicalTypeId " <> tshow (unCanonicalTypeId (sdCanonical declaration)),-      "          , cpBindingSymbol = QualifiedValueName " <> tshow (unQualifiedValueName (sdBinding declaration)),-      "          , cpBindingVersion = BindingVersion " <> tshow (unBindingVersion (sdBindingVersion declaration)),-      "          , cpWireFingerprint = " <> tshow (wireFingerprint graph name),-      "          }",-      "  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))",-      "",-      "loadGolden :: HistoricalCodec " <> domainType <> " -> FilePath -> IO (Either CompareInputIssue (CompareObservation, [Value]))",-      "loadGolden historicalCodec path = do",-      "  decoded <- Aeson.eitherDecodeFileStrict path",-      "  pure $ case decoded of",-      "    Left reason -> Left (HistoricalGoldenUnreadable path (fromString reason))",-      "    Right inputValue ->",-      "      let historicalDecoded = hcDecode historicalCodec inputValue",-      "          historicalOutcome = normalizeDecode historicalDecoded",-      "          generatedOutcome = normalizeDecode (GeneratedCodec.decode" <> name <> "Mapped inputValue)",-      "          observation = DecodeObservation path inputValue historicalOutcome generatedOutcome",-      "          coveredValues = case historicalDecoded of",-      "            Right value -> [inputValue, GeneratedCodec.encode" <> name <> "Mapped value]",-      "            Left _ -> []",-      "       in Right (observation, coveredValues)",-      "",-      "normalizeDecode :: Either Text " <> domainType <> " -> DecodeOutcome",-      "normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encode" <> name <> "Mapped)",-      "",-      "fromString :: String -> Text",-      "fromString = Data.Text.pack",-      "",-      "branchSchema :: BranchSchema",-      "branchSchema = " <> renderBranchSchema (branchSchemaFor graph (ResolvedStructural declaration shape))-    ]-  where-    name = sdName declaration-    domainType = renderReferenceOrDie importPlan (haskellTypeReference (sdHaskell declaration))-    codecModule = genPrefixFor ctx (aggName owner) <> ".Codec"-    fixtureReference = renderReferenceOrDie importPlan (qualifiedValueReference (sdFixtures declaration))-    importPlan =-      planImportsOrDie-        moduleName-        Set.empty-        ( Set.fromList-            [ haskellTypeReference (sdHaskell declaration),-              qualifiedValueReference (sdFixtures declaration)-            ]-        )--branchSchemaFor :: TypeGraph -> ResolvedMappedDecl -> BranchSchema-branchSchemaFor graph =-  foldMappedDecl-    MappedDeclAlgebra-      { onStructuralDecl = \_ shape ->-          foldMappedShape-            MappedShapeAlgebra-              { onRecord = \_ _ fields ->-                  BranchRecord-                    [ BranchField-                        (rwfKey field)-                        (rwfPresence field == POptional)-                        (branchExpr graph (rwfType field))-                    | field <- fields-                    ],-                onEnum = const BranchScalar,-                onUnion = \encoding arms ->-                  BranchUnion-                    (ueTagField encoding)-                    (ueContentsField encoding)-                    [BranchArm (rwaTag arm) (branchExpr graph <$> rwaPayload arm) | arm <- arms]-              }-            shape,-        onOpaqueDecl = const BranchScalar-      }--branchExpr :: TypeGraph -> ResolvedTypeExpr -> BranchSchema-branchExpr graph =-  foldTypeExpr-    TypeExprAlgebra-      { onText = BranchScalar,-        onInt = BranchScalar,-        onInteger = BranchScalar,-        onBool = BranchScalar,-        onNatural = BranchScalar,-        onTime = BranchScalar,-        onJson = BranchScalar,-        onOptional = BranchOptional,-        onList = BranchList,-        onMap = BranchMap,-        onRef = \key -> maybe BranchScalar (branchSchemaFor graph) (Map.lookup key (tgDeclarations graph))-      }--renderBranchSchema :: BranchSchema -> Text-renderBranchSchema schema = case schema of-  BranchScalar -> "BranchScalar"-  BranchOptional nested -> "BranchOptional (" <> renderBranchSchema nested <> ")"-  BranchList nested -> "BranchList (" <> renderBranchSchema nested <> ")"-  BranchMap nested -> "BranchMap (" <> renderBranchSchema nested <> ")"-  BranchRecord fields ->-    "BranchRecord ["-      <> T.intercalate-        ", "-        [ "BranchField "-            <> tshow (bfWireKey field)-            <> " "-            <> (if bfPresenceOptional field then "True" else "False")-            <> " ("-            <> renderBranchSchema (bfSchema field)-            <> ")"-        | field <- fields-        ]-      <> "]"-  BranchUnion tagField contentsField arms ->-    "BranchUnion "-      <> tshow tagField-      <> " "-      <> tshow contentsField-      <> " ["-      <> T.intercalate-        ", "-        [ "BranchArm "-            <> tshow (baWireTag arm)-            <> " "-            <> maybe "Nothing" (\nested -> "(Just (" <> renderBranchSchema nested <> "))") (baPayloadSchema arm)-        | arm <- arms-        ]-      <> "]"---- | Emit one create-once consumer module per distinct qualified obligation--- owner. Multiple mapped declarations may intentionally share a leaf binding--- module, so grouping happens by module rather than by declaration.-bindingSkeletonModules :: Context -> Spec -> TypeGraph -> [ScaffoldModule]-bindingSkeletonModules ctx spec graph = map fst (bindingSkeletonOwners ctx spec graph)---- | 'bindingSkeletonModules' paired with the mapped declarations whose--- obligations each skeleton carries, in first-appearance order. A skeleton shared--- by declarations from different member files therefore names all of them, which--- is what lets whole-workspace scaffolding treat it as context-level rather than--- attributing it to an arbitrary member.-bindingSkeletonOwners :: Context -> Spec -> TypeGraph -> [(ScaffoldModule, [Name])]-bindingSkeletonOwners ctx spec graph = bindingSkeletonOwnersWithObligations ctx spec graph (bindingObligations spec)--bindingSkeletonOwnersForService :: Context -> CheckedService -> TypeGraph -> [(ScaffoldModule, [Name])]-bindingSkeletonOwnersForService ctx service graph =-  bindingSkeletonOwnersWithObligations ctx (checkedSpec service) graph (bindingObligationsForService service)--bindingSkeletonOwnersWithObligations :: Context -> Spec -> TypeGraph -> Either errors [BindingObligation] -> [(ScaffoldModule, [Name])]-bindingSkeletonOwnersWithObligations ctx spec graph obligationResult = case obligationResult of-  Left _ -> []-  Right obligations ->-    [ (emitBindingSkeleton ctx spec graph owner entries, nub (map obligationMappedName entries))-    | (owner, entries) <- Map.toAscList (Map.fromListWith (<>) [(obligationModule obligation, [obligation]) | obligation <- obligations])-    ]--emitBindingSkeleton :: Context -> Spec -> TypeGraph -> Text -> [BindingObligation] -> ScaffoldModule-emitBindingSkeleton ctx spec graph owner obligations =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" owner <> ".hs"),-      moduleText =-        nl $-          [ "{-# LANGUAGE DataKinds #-}",-            "{-# LANGUAGE LambdaCase #-}",-            "",-            "-- This is a HAND-OWNED consumer binding skeleton. keiro-dsl creates it once",-            "-- and never overwrites it. Fill each HOLE and run the generated harness.",-            "module " <> owner <> " ("-          ]-            <> exportLines-            <> [") where", ""]-            <> importLines-            <> [""]-            <> intercalateBlank (map renderObligation obligations),-      kind = HoleStub,-      origin = "consumer binding skeleton " <> owner-    }-  where-    exportLines =-      [ (if index == (0 :: Int) then "    " else "  , ") <> obligationSymbol obligation-      | (index, obligation) <- zip [0 ..] obligations-      ]-    importPlan = bindingSkeletonImportPlan ctx spec graph owner obligations-    importLines =-      sort . nub $-        map ("import " <>) staticImports-          <> T.lines (renderPlannedImports importPlan)-    staticImports =-      sort . nub $-        [ "Keiro.Codec.Structural (FixtureCases, StructuralBinding (..))"-        | any (\obligation -> obligationCategory obligation == "structural" && obligationKind obligation `elem` [BindingValue, FixtureValue]) obligations-        ]-          <> [ "Keiro.Codec.Nominal (NominalBinding (..), NominalFixtureCases)"-             | any ((/= "structural") . obligationCategory) obligations-             ]-          <> [ "Data.KindID (KindID)"-             | obligation <- obligations,-               Just (nominal, _) <- [nominalFor obligation],-               IdRepresentation {} <- [resolvedNominalRepresentation nominal]-             ]-          <> [ "Data.Text (Text)"-             | obligation <- obligations,-               Just (nominal, _) <- [nominalFor obligation],-               ScalarRepresentation NominalText <- [resolvedNominalRepresentation nominal]-             ]-          <> [ "Data.Time (UTCTime)"-             | obligation <- obligations,-               Just (nominal, _) <- [nominalFor obligation],-               ScalarRepresentation NominalTime <- [resolvedNominalRepresentation nominal]-             ]-          <> [ "Numeric.Natural (Natural)"-             | obligation <- obligations,-               Just (nominal, _) <- [nominalFor obligation],-               ScalarRepresentation NominalNatural <- [resolvedNominalRepresentation nominal]-             ]-    renderObligation obligation = case structuralFor obligation of-      Nothing -> case nominalFor obligation of-        Just (nominal, binding) -> renderNominalObligation nominal binding obligation-        Nothing -> ["-- HOLE: declaration disappeared before skeleton rendering"]-      Just (declaration, shape) -> case obligationKind obligation of-        BindingValue -> renderBinding importPlan ctx declaration shape obligation-        FixtureValue ->-          [ "-- HOLE: provide deterministic labelled conformance fixtures for " <> sdName declaration,-            renderStructuralObligationSignature importPlan declaration obligation,-            obligationSymbol obligation <> " = error " <> tshow ("HOLE: fill " <> sdName declaration <> " fixtures")-          ]-        InitialValue ->-          [ "-- HOLE: provide the initial register value for " <> sdName declaration,-            renderStructuralObligationSignature importPlan declaration obligation,-            obligationSymbol obligation <> " = error " <> tshow ("HOLE: fill " <> sdName declaration <> " initial value")-          ]-    structuralFor obligation = case Map.lookup (MappedKey (obligationMappedName obligation)) (tgDeclarations graph) of-      Just (ResolvedStructural declaration shape) -> Just (declaration, shape)-      _ -> Nothing-    nominalFor obligation = do-      registry <- either (const Nothing) Just (resolveNominalTypes spec)-      nominal <- lookupNominalType (obligationMappedName obligation) registry-      binding <- case resolvedNominalOwnership nominal of-        ConsumerNominal value -> Just value-        GeneratedNominal -> Nothing-      pure (nominal, binding)-    renderNominalObligation nominal binding obligation = case obligationKind obligation of-      BindingValue ->-        [ "-- HOLE: complete both total directions; the generated codec remains wire authority.",-          renderNominalObligationSignature importPlan ctx nominal binding obligation,-          obligationSymbol obligation <> " =",-          "  NominalBinding",-          "    { nominalToRepresentation = \\_domainValue -> error " <> tshow ("HOLE: fill " <> resolvedNominalName nominal <> " nominalToRepresentation"),-          "    , nominalFromRepresentation = \\_representationValue -> error " <> tshow ("HOLE: fill " <> resolvedNominalName nominal <> " nominalFromRepresentation"),-          "    }"-        ]-      FixtureValue ->-        [ "-- HOLE: provide deterministic labelled expected-wire fixtures for " <> resolvedNominalName nominal,-          renderNominalObligationSignature importPlan ctx nominal binding obligation,-          obligationSymbol obligation <> " = error " <> tshow ("HOLE: fill " <> resolvedNominalName nominal <> " fixtures")-        ]-      InitialValue ->-        [ "-- HOLE: provide the initial register value for " <> resolvedNominalName nominal,-          renderNominalObligationSignature importPlan ctx nominal binding obligation,-          obligationSymbol obligation <> " = error " <> tshow ("HOLE: fill " <> resolvedNominalName nominal <> " initial value")-        ]-    intercalateBlank [] = []-    intercalateBlank (section : rest) = section <> concatMap ("" :) rest--renderBinding :: HaskellImportPlan -> Context -> StructuralDecl -> ResolvedMappedShape -> BindingObligation -> [Text]-renderBinding importPlan ctx declaration shape obligation =-  [ "-- HOLE: complete both total directions; wire policy remains in the generated codec.",-    obligationSymbol obligation <> " :: StructuralBinding " <> domainType <> " " <> shapeType,-    obligationSymbol obligation <> " =",-    "  StructuralBinding",-    "    { bindingToShape = \\case"-  ]-    <> indentCases (bindingCases True)-    <> ["    , bindingFromShape = \\case"]-    <> indentCases (bindingCases False)-    <> ["    }"]-  where-    domainType = renderReferenceOrDie importPlan (haskellTypeReference (sdHaskell declaration))-    shapeModuleName = structuralShapeModule ctx (sdName declaration)-    shapeType = renderReferenceOrDie importPlan (qualifiedTypeReference shapeModuleName (sdName declaration <> "Shape"))-    domainCtor constructor = renderReferenceOrDie importPlan (constructorReference (hsModule (sdHaskell declaration)) constructor)-    shapeCtor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)-    indentCases = map ("      " <>)-    bindingCases toShapeDirection =-      foldMappedShape-        MappedShapeAlgebra-          { onRecord = \constructor _ fields -> [recordCase toShapeDirection constructor fields],-            onEnum = \entries -> map (enumCase toShapeDirection . weCtor) entries,-            onUnion = \_ arms -> map (unionCase toShapeDirection) arms-          }-        shape-    recordCase toShapeDirection constructor fields =-      sourceCtor-        <> arguments variables-        <> " -> "-        <> targetCtor-        <> arguments (map (holeFor toShapeDirection . rwfHaskell) fields)-      where-        variables = map (("_" <>) . (<> "Value") . rwfHaskell) fields-        sourceCtor = if toShapeDirection then domainCtor constructor else shapeCtor constructor-        targetCtor = if toShapeDirection then shapeCtor constructor else domainCtor constructor-    enumCase toShapeDirection constructor =-      sourceCtor <> " -> " <> holeFor toShapeDirection constructor-      where-        sourceCtor = if toShapeDirection then domainCtor constructor else shapeCtor constructor-    unionCase toShapeDirection arm =-      sourceCtor-        <> maybe "" (const " _payloadValue") (rwaPayload arm)-        <> " -> "-        <> case rwaPayload arm of-          Nothing -> holeFor toShapeDirection (rwaCtor arm)-          Just _ -> targetCtor <> " " <> holeFor toShapeDirection (rwaCtor arm <> ".payload")-      where-        sourceCtor = if toShapeDirection then domainCtor (rwaCtor arm) else shapeCtor (rwaCtor arm)-        targetCtor = if toShapeDirection then shapeCtor (rwaCtor arm) else domainCtor (rwaCtor arm)-    arguments [] = ""-    arguments values = " " <> T.unwords values-    holeFor toShapeDirection fieldName =-      "(error "-        <> tshow-          ( "HOLE: fill "-              <> sdName declaration-              <> (if toShapeDirection then " bindingToShape." else " bindingFromShape.")-              <> fieldName-          )-        <> ")"--bindingSkeletonImportPlan :: Context -> Spec -> TypeGraph -> Text -> [BindingObligation] -> HaskellImportPlan-bindingSkeletonImportPlan ctx spec graph owner obligations =-  planImportsOrDie owner (Set.fromList (map obligationSymbol obligations)) (Set.fromList (concatMap obligationReferences obligations))-  where-    obligationReferences obligation = case Map.lookup (MappedKey (obligationMappedName obligation)) (tgDeclarations graph) of-      Just (ResolvedStructural declaration shape) ->-        haskellTypeReference (sdHaskell declaration)-          : [ qualifiedTypeReference shapeModuleName (sdName declaration <> "Shape")-            | obligationKind obligation == BindingValue-            ]-            <> [ reference-               | obligationKind obligation == BindingValue,-                 constructor <- structuralConstructorNames shape,-                 reference <--                   [ constructorReference (hsModule (sdHaskell declaration)) constructor,-                     constructorReference shapeModuleName constructor-                   ]-               ]-        where-          shapeModuleName = structuralShapeModule ctx (sdName declaration)-      _ -> case nominalForName (obligationMappedName obligation) of-        Just (nominal, binding) ->-          haskellTypeReference (consumerNominalHaskell binding)-            : [ qualifiedTypeReference-                  (nominalRepresentationModule ctx (resolvedNominalName nominal))-                  (resolvedNominalName nominal <> "Representation")-              | obligationKind obligation == BindingValue,-                EnumRepresentation {} <- [resolvedNominalRepresentation nominal]-              ]-        Nothing -> []-    nominalForName name = do-      registry <- either (const Nothing) Just (resolveNominalTypes spec)-      nominal <- lookupNominalType name registry-      binding <- case resolvedNominalOwnership nominal of-        ConsumerNominal value -> Just value-        GeneratedNominal -> Nothing-      pure (nominal, binding)--structuralConstructorNames :: ResolvedMappedShape -> [Text]-structuralConstructorNames =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \constructor _ _ -> [constructor],-        onEnum = map weCtor,-        onUnion = \_ -> map rwaCtor-      }--structuralShapeReferences :: Context -> StructuralDecl -> ResolvedMappedShape -> [HaskellReference]-structuralShapeReferences ctx declaration shape =-  qualifiedTypeReference moduleName (sdName declaration <> "Shape")-    : [constructorReference moduleName constructor | constructor <- structuralConstructorNames shape]-      <> [ HaskellReference moduleName selector ValueNamespace RequireQualified-         | selector <- structuralSelectorNames shape-         ]-  where-    moduleName = structuralShapeModule ctx (sdName declaration)--structuralSelectorNames :: ResolvedMappedShape -> [Text]-structuralSelectorNames =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \_ _ -> map rwfHaskell,-        onEnum = const [],-        onUnion = \_ _ -> []-      }--nominalRepresentationEncoderReference :: Context -> ResolvedNominalType -> HaskellReference-nominalRepresentationEncoderReference ctx nominal =-  HaskellReference-    (nominalRepresentationModule ctx name)-    (lowerFirst name <> "RepresentationText")-    ValueNamespace-    RequireQualified-  where-    name = resolvedNominalName nominal--nominalRepresentationConstructorReference :: Context -> ResolvedNominalType -> Text -> HaskellReference-nominalRepresentationConstructorReference ctx nominal constructor =-  HaskellReference-    (nominalRepresentationModule ctx (resolvedNominalName nominal))-    constructor-    ConstructorNamespace-    RequireQualified--renderStructuralObligationSignature :: HaskellImportPlan -> StructuralDecl -> BindingObligation -> Text-renderStructuralObligationSignature importPlan declaration obligation =-  obligationSymbol obligation-    <> " :: "-    <> case obligationKind obligation of-      BindingValue -> error "structural binding signatures are rendered with renderBinding"-      FixtureValue -> "FixtureCases " <> domainType-      InitialValue -> domainType-  where-    domainType = renderReferenceOrDie importPlan (haskellTypeReference (sdHaskell declaration))--renderNominalObligationSignature :: HaskellImportPlan -> Context -> ResolvedNominalType -> ConsumerNominalBinding -> BindingObligation -> Text-renderNominalObligationSignature importPlan ctx nominal binding obligation =-  obligationSymbol obligation-    <> " :: "-    <> case obligationKind obligation of-      BindingValue -> "NominalBinding " <> domainType <> " " <> representationType-      FixtureValue -> "NominalFixtureCases " <> domainType-      InitialValue -> domainType-  where-    domainType = renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding))-    representationType = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> "(KindID " <> tshow prefix <> ")"-      EnumRepresentation {} ->-        renderReferenceOrDie-          importPlan-          ( qualifiedTypeReference-              (nominalRepresentationModule ctx (resolvedNominalName nominal))-              (resolvedNominalName nominal <> "Representation")-          )-      ScalarRepresentation NominalText -> "Text"-      ScalarRepresentation NominalInt -> "Int"-      ScalarRepresentation NominalNatural -> "Natural"-      ScalarRepresentation NominalBool -> "Bool"-      ScalarRepresentation NominalTime -> "UTCTime"--qualifiedTypeReference :: Text -> Text -> HaskellReference-qualifiedTypeReference moduleName typeName =-  HaskellReference moduleName typeName TypeNamespace RequireQualified--constructorReference :: Text -> Text -> HaskellReference-constructorReference moduleName constructor =-  HaskellReference moduleName constructor ConstructorNamespace RequireQualified--shapeModule :: Context -> TypeGraph -> (StructuralDecl, ResolvedMappedShape) -> ScaffoldModule-shapeModule ctx graph (declaration, shape) =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" (structuralShapeModule ctx (sdName declaration)) <> ".hs"),-      moduleText = emitShape ctx graph declaration shape,-      kind = Generated,-      origin = nodeOrigin "mapped structural" (sdName declaration) (sdLoc declaration)-    }--structuralPrefix :: Context -> Text-structuralPrefix ctx = case placement ctx of-  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".Structural"-  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated.Structural"--structuralShapeModule :: Context -> Name -> Text-structuralShapeModule ctx name = structuralPrefix ctx <> ".Shape." <> name--nominalRepresentationModule :: Context -> Name -> Text-nominalRepresentationModule ctx name = case placement ctx of-  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".Nominal.Shape." <> name-  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Nominal.Shape." <> name <> ".Generated"---- | Emit the one generated nominal authority for the complete context. The--- empty declaration attribution is intentional: in a workspace this module is--- context-level even when all declarations currently happen to live in one--- member, so moving that member cannot move Haskell type ownership.-generatedNominalOwners :: Context -> CheckedService -> [(ScaffoldModule, [Name])]-generatedNominalOwners ctx service = case planNominalGenerationForService ctx service of-  Left _ -> []-  Right [] -> []-  Right owners ->-    [ ( ScaffoldModule-          { modulePath = T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> ".hs"),-            moduleText = emitGeneratedNominals languageContract ctx owners,-            kind = Generated,-            origin = "context " <> specContext spec <> " generated nominal declarations"-          },-        []-      )-    ]-      <> [ ( ScaffoldModule-               { modulePath = T.unpack (T.replace "." "/" (generatedNominalInternalModule ctx) <> ".hs"),-                 moduleText = emitGeneratedNominalInternals ctx enforcingIds,-                 kind = Generated,-                 origin = "context " <> specContext spec <> " generated nominal ID internals"-               },-             []-           )-         | not (null enforcingIds)-         ]-    where-      enforcingIds =-        [ (nominal, contract)-        | owner <- owners,-          let nominal = nominalDeclaration owner,-          IdRepresentation prefix <- [resolvedNominalRepresentation nominal],-          Just contract <- [idDomainContractFor languageContract prefix]-        ]-  where-    spec = checkedSpec service-    languageContract = checkedLanguageContract service--generatedNominalInternalModule :: Context -> Text-generatedNominalInternalModule ctx = generatedNominalModule ctx <> ".Internal"--emitGeneratedNominals :: EffectiveLanguageContract -> Context -> [NominalGenerationOwner] -> Text-emitGeneratedNominals languageContract ctx owners =-  nl-    ( renderGeneratedLanguagePragmas localExtensions-        <> [ generatedBanner,-             moduleHeader,-             ""-           ]-        <> baseImports-        <> internalImports-        <> equalityImports-        <> if T.null declarations then [] else ["", declarations]-    )-  where-    usesEquality = any nominalEqualityUsed owners-    exactEqualityOwners = [owner | owner <- owners, nominalEqualityUsed owner, exactOwner (nominalDeclaration owner)]-    inexactEqualityOwners = [owner | owner <- owners, nominalEqualityUsed owner, not (exactOwner (nominalDeclaration owner))]-    usesExactEquality = not (null exactEqualityOwners)-    usesInexactEquality = not (null inexactEqualityOwners)-    legacyNominals =-      [ nominal-      | owner <- owners,-        let nominal = nominalDeclaration owner,-        case resolvedNominalRepresentation nominal of-          IdRepresentation prefix -> not (isJust (idDomainContractFor languageContract prefix))-          EnumRepresentation {} -> True-          ScalarRepresentation {} -> False-      ]-    hasExactEnum = any (\owner -> case resolvedNominalRepresentation (nominalDeclaration owner) of EnumRepresentation {} -> True; _ -> False) exactEqualityOwners-    hasExactEnforcedId = any (\owner -> case resolvedNominalRepresentation (nominalDeclaration owner) of IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix); _ -> False) exactEqualityOwners-    enforcingIds =-      [ nominal-      | owner <- owners,-        let nominal = nominalDeclaration owner,-        IdRepresentation prefix <- [resolvedNominalRepresentation nominal],-        Just _ <- [idDomainContractFor languageContract prefix]-      ]-    moduleHeader-      | null enforcingIds = "module " <> generatedNominalModule ctx <> " where"-      | otherwise =-          nl-            [ "module " <> generatedNominalModule ctx,-              "  ( " <> T.intercalate "\n  , " (concatMap ownerExports owners),-              "  ) where"-            ]-    ownerExports owner =-      baseExports <> equalityExports-      where-        nominal = nominalDeclaration owner-        name = resolvedNominalName nominal-        baseExports = case resolvedNominalRepresentation nominal of-          IdRepresentation prefix-            | Just _ <- idDomainContractFor languageContract prefix ->-                [name, "parse" <> name, "mk" <> name, nominalTextName nominal]-          _ -> [name <> " (..)", nominalTextName nominal]-        equalityExports =-          if nominalEqualityUsed owner-            then [nominalEqualityTagName nominal, nominalEqualityWitnessName nominal]-            else []-    localExtensions =-      [ExtDeriveAnyClass | any (nominalUsesDeriveAnyClass . nominalDeclaration) owners]-        <> [ExtTypeFamilies | usesEquality]-    baseImports =-      ["import Data.Aeson (FromJSON, ToJSON)" | not (null legacyNominals)]-        <> ["import Data.Text (Text)" | not (null legacyNominals) || usesEquality]-        <> ["import GHC.Generics (Generic)" | not (null legacyNominals)]-        <> ["import Keiki.Shape (CanonicalTypeName)" | not (null legacyNominals)]-    equalityImports =-      [ "import Keiki.Core (" <> T.intercalate ", " coreImports <> ")"-      | usesEquality-      ]-        <> ["import Data.List.NonEmpty (NonEmpty (..))" | hasExactEnum]-        <> [ "import Keiki.ProjectionDomain (" <> T.intercalate ", " projectionDomainImports <> ")"-           | not (null projectionDomainImports)-           ]-        <> ["import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain)" | hasExactEnforcedId]-      where-        coreImports =-          ["FieldProjection (..)", "FieldWitness"]-            <> (if usesExactEquality then ["ExactFieldProjection (..)", "exactFieldWitness"] else [])-            <> ["fieldWitness" | usesInexactEquality]-        projectionDomainImports =-          ["finiteProjectionDomain" | hasExactEnum]-            <> (if hasExactEnforcedId then ["TextPattern", "textProjectionDomain"] else [])-    internalImports =-      [ "import "-          <> generatedNominalInternalModule ctx-          <> " ("-          <> T.intercalate-            ", "-            (concatMap (\nominal -> [resolvedNominalName nominal, "mk" <> resolvedNominalName nominal, "parse" <> resolvedNominalName nominal, nominalTextName nominal]) enforcingIds)-          <> ")"-      | not (null enforcingIds)-      ]-    declarations = T.dropWhileEnd (== '\n') (sectionsOf [map emitOwner owners])-    emitOwner owner = emitGeneratedNominal languageContract (nominalEqualityUsed owner) (nominalDeclaration owner)-    exactOwner nominal = case resolvedNominalRepresentation nominal of-      EnumRepresentation {} -> True-      IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix)-      ScalarRepresentation {} -> False-    nominalUsesDeriveAnyClass nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> not (isJust (idDomainContractFor languageContract prefix))-      EnumRepresentation {} -> True-      ScalarRepresentation {} -> False--emitGeneratedNominal :: EffectiveLanguageContract -> Bool -> ResolvedNominalType -> Text-emitGeneratedNominal languageContract equalityUsed nominal = case resolvedNominalRepresentation nominal of-  IdRepresentation prefix-    | Just _ <- idDomainContractFor languageContract prefix ->-        nl equalitySection-  IdRepresentation {} ->-    nl $-      [ "newtype " <> name <> " = " <> name <> " Text",-        "  deriving stock (Generic, Eq, Ord, Show)",-        "  deriving anyclass (ToJSON, FromJSON)",-        "",-        "instance CanonicalTypeName " <> name,-        "",-        nominalTextName nominal <> " :: " <> name <> " -> Text",-        nominalTextName nominal <> " (" <> name <> " value) = value"-      ]-        <> equalitySection-  EnumRepresentation constructors ->-    nl $-      [ "data " <> name <> " = " <> T.intercalate " | " (map fst (NE.toList constructors)),-        "  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)",-        "  deriving anyclass (ToJSON, FromJSON)",-        "",-        "instance CanonicalTypeName " <> name,-        "",-        nominalTextName nominal <> " :: " <> name <> " -> Text",-        nominalTextName nominal <> " = \\case",-        nl ["  " <> constructor <> " -> " <> tshow wire | (constructor, wire) <- NE.toList constructors]-      ]-        <> equalitySection-  ScalarRepresentation {} ->-    error "generated nominal scalar reached generated declaration emission"-  where-    name = resolvedNominalName nominal-    equalitySection = if equalityUsed then ["", emitGeneratedNominalEquality languageContract nominal] else []--emitGeneratedNominalEquality :: EffectiveLanguageContract -> ResolvedNominalType -> Text-emitGeneratedNominalEquality languageContract nominal =-  nl $-    [ "data " <> tagName,-      "",-      "instance FieldProjection " <> tagName <> " where",-      "  type FieldName " <> tagName <> " = " <> tshow name,-      "  type FieldOwner " <> tagName <> " = " <> name,-      "  type FieldResult " <> tagName <> " = Text",-      "  fieldShapeId _ = " <> tshow equalityIdentity,-      "  projectFieldValue _ = " <> nominalTextName nominal-    ]-      <> exactInstance-      <> [ "",-           witnessName <> " :: FieldWitness " <> tagName,-           witnessName <> " = " <> witnessConstructor <> " @" <> tagName-         ]-  where-    name = resolvedNominalName nominal-    tagName = nominalEqualityTagName nominal-    witnessName = nominalEqualityWitnessName nominal-    equalityIdentity = fromMaybe (error "generated nominal equality contract missing") (nominalEqualityIdentityForService languageContract nominal)-    (exactInstance, witnessConstructor) = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> case idDomainContractFor languageContract prefix of-        Nothing -> ([], "fieldWitness")-        Just _ ->-          ( [ "",-              patternName <> " :: TextPattern",-              patternName <> " = either (error . show) id (idDomainTextPattern (typeIdV7Domain " <> tshow prefix <> "))",-              "",-              "instance ExactFieldProjection " <> tagName <> " where",-              "  fieldProjectionDomain _ = textProjectionDomain " <> patternName,-              "  reconstructFieldOwner _ = either (const Nothing) Just . parse" <> name-            ],-            "exactFieldWitness"-          )-      EnumRepresentation constructors ->-        ( [ "",-            "instance ExactFieldProjection " <> tagName <> " where",-            "  fieldProjectionDomain _ = finiteProjectionDomain (" <> renderNonEmpty (map (tshow . snd) (NE.toList constructors)) <> ")",-            "  reconstructFieldOwner _ = \\case"-          ]-            <> ["    " <> tshow wire <> " -> Just " <> constructor | (constructor, wire) <- NE.toList constructors]-            <> ["    _ -> Nothing"],-          "exactFieldWitness"-        )-      ScalarRepresentation {} -> error "generated nominal scalar equality emission"-    patternName = lowerFirst name <> "IdDomainPattern"--emitGeneratedNominalInternals :: Context -> [(ResolvedNominalType, IdDomainContract)] -> Text-emitGeneratedNominalInternals ctx nominals =-  nl-    [ generatedBanner,-      "module " <> generatedNominalInternalModule ctx,-      "  ( " <> T.intercalate "\n  , " (concatMap exportsFor nominals),-      "  ) where",-      "",-      "import Data.Aeson (FromJSON (..), ToJSON (..), withText)",-      "import Data.Text (Text)",-      "import Data.Text qualified as T",-      "import GHC.Generics (Generic)",-      "import Keiki.Shape (CanonicalTypeName)",-      "import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)",-      "",-      sectionsOf [map emitInternal nominals]-    ]-  where-    exportsFor (nominal, _) =-      [ resolvedNominalName nominal,-        "parse" <> resolvedNominalName nominal,-        "mk" <> resolvedNominalName nominal,-        nominalTextName nominal,-        legacyNominalConstructorName nominal-      ]-    emitInternal (nominal, contract) =-      nl-        [ "newtype " <> name <> " = " <> name <> " Text",-          "  deriving stock (Generic, Eq, Ord, Show)",-          "",-          "instance CanonicalTypeName " <> name,-          "",-          "instance ToJSON " <> name <> " where",-          "  toJSON = toJSON . " <> textName,-          "",-          "instance FromJSON " <> name <> " where",-          "  parseJSON = withText " <> tshow name <> " (either (fail . T.unpack) pure . parse" <> name <> ")",-          "",-          "parse" <> name <> " :: Text -> Either Text " <> name,-          "parse" <> name <> " input = case validateIdDomainText (typeIdV7Domain " <> tshow (idDomainPrefix contract) <> ") input of",-          "  Left reason -> Left (T.pack (show reason))",-          "  Right () -> Right (" <> name <> " input)",-          "",-          "mk" <> name <> " :: Text -> Either Text " <> name,-          "mk" <> name <> " = parse" <> name,-          "",-          textName <> " :: " <> name <> " -> Text",-          textName <> " (" <> name <> " value) = value",-          "",-          legacyNominalConstructorName nominal <> " :: Text -> " <> name,-          legacyNominalConstructorName nominal <> " = " <> name-        ]-      where-        name = resolvedNominalName nominal-        textName = nominalTextName nominal--nominalEqualityTagName :: ResolvedNominalType -> Text-nominalEqualityTagName nominal = resolvedNominalName nominal <> "EqualityProjection"--nominalEqualityWitnessName :: ResolvedNominalType -> Text-nominalEqualityWitnessName nominal = lowerFirst (resolvedNominalName nominal) <> "EqualityWitness"--renderNonEmpty :: [Text] -> Text-renderNonEmpty values = case values of-  [] -> error "cannot render an empty exact projection domain"-  firstValue : rest -> firstValue <> " :| [" <> T.intercalate ", " rest <> "]"--nominalTextName :: ResolvedNominalType -> Text-nominalTextName = (<> "Text") . lowerFirst . resolvedNominalName---- | Explicit type/constructor imports for exactly the generated declarations a--- generated aggregate module uses. Keeping an import list avoids making every--- aggregate depend on every service declaration merely because they share the--- one owner module.-generatedNominalTypeImports :: Context -> [ResolvedNominalType] -> [Text]-generatedNominalTypeImports _ [] = []-generatedNominalTypeImports ctx nominals =-  [ "import "-      <> generatedNominalModule ctx-      <> " ("-      <> T.intercalate ", " [resolvedNominalName nominal <> " (..)" | nominal <- stableNominals nominals]-      <> ")"-  ]--generatedNominalTypeImportsForService :: CheckedService -> Context -> [ResolvedNominalType] -> [Text]-generatedNominalTypeImportsForService service ctx nominals =-  generatedNominalTypeImportsWithParsers service ctx nominals nominals---- | As 'generatedNominalTypeImportsForService', but importing an enforced ID's--- @parse\<Name\>@ only for the nominals in @parsing@.------ The parser is emitted only where a literal of that ID is constructed. A module--- that merely mentions the type — a guard operand, say — needs the type name and--- nothing else, and importing the parser there is an unused import.-generatedNominalTypeImportsWithParsers :: CheckedService -> Context -> [ResolvedNominalType] -> [ResolvedNominalType] -> [Text]-generatedNominalTypeImportsWithParsers _ _ [] _ = []-generatedNominalTypeImportsWithParsers service ctx nominals parsing =-  [ "import "-      <> generatedNominalModule ctx-      <> " ("-      <> T.intercalate ", " (concatMap importsFor (stableNominals nominals))-      <> ")"-  ]-  where-    parsingNames = map resolvedNominalName (stableNominals parsing)-    importsFor nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix-        | Just _ <- idDomainContractFor (checkedLanguageContract service) prefix ->-            [resolvedNominalName nominal]-              <> ["parse" <> resolvedNominalName nominal | resolvedNominalName nominal `elem` parsingNames]-      _ -> [resolvedNominalName nominal <> " (..)"]--generatedNominalCodecImports :: CheckedService -> Context -> [ResolvedNominalType] -> [Text]-generatedNominalCodecImports _ _ [] = []-generatedNominalCodecImports service ctx nominals =-  [ "import "-      <> generatedNominalModule ctx-      <> " ("-      <> T.intercalate-        ", "-        ( concat-            [ publicImports nominal-            | nominal <- stableNominals nominals-            ]-        )-      <> ")"-  ]-    <> [ "import "-           <> generatedNominalInternalModule ctx-           <> " ("-           <> T.intercalate ", " [legacyNominalConstructorName nominal | nominal <- enforcingIds]-           <> ")"-       | not (null enforcingIds)-       ]-  where-    publicImports nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix-        | Just _ <- idDomainContractFor (checkedLanguageContract service) prefix -> [nominalTextName nominal]-      _ -> [resolvedNominalName nominal <> " (..)", nominalTextName nominal]-    enforcingIds =-      [ nominal-      | nominal <- stableNominals nominals,-        IdRepresentation prefix <- [resolvedNominalRepresentation nominal],-        Just _ <- [idDomainContractFor (checkedLanguageContract service) prefix]-      ]--legacyNominalConstructorName :: ResolvedNominalType -> Text-legacyNominalConstructorName nominal = "unsafe" <> resolvedNominalName nominal <> "FromLegacyText"--stableNominals :: [ResolvedNominalType] -> [ResolvedNominalType]-stableNominals = Map.elems . Map.fromList . map (\nominal -> (resolvedNominalName nominal, nominal))--nominalRepresentationOwners :: Context -> Spec -> [(ScaffoldModule, [Name])]-nominalRepresentationOwners ctx spec = case resolveNominalTypes spec of-  Left _ -> []-  Right registry ->-    [ (nominalRepresentationModuleValue ctx nominal constructors, [resolvedNominalName nominal])-    | nominal <- Map.elems (nominalTypes registry),-      ConsumerNominal {} <- [resolvedNominalOwnership nominal],-      EnumRepresentation constructors <- [resolvedNominalRepresentation nominal]-    ]--nominalRepresentationModuleValue :: Context -> ResolvedNominalType -> NonEmpty (Name, Text) -> ScaffoldModule-nominalRepresentationModuleValue ctx nominal constructors =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-      moduleText =-        nl-          [ generatedBanner,-            "module " <> moduleName <> " (" <> representationType <> " (..), " <> encoderName <> ") where",-            "",-            "import Data.Text (Text)",-            "import GHC.Generics (Generic)",-            "",-            "data " <> representationType <> " = " <> T.intercalate " | " (map fst (NE.toList constructors)),-            "  deriving stock (Eq, Generic, Ord, Show, Enum, Bounded)",-            "",-            encoderName <> " :: " <> representationType <> " -> Text",-            encoderName <> " = \\case",-            nl ["  " <> constructor <> " -> " <> tshow wire | (constructor, wire) <- NE.toList constructors]-          ],-      kind = Generated,-      origin = nodeOrigin "bound nominal enum representation" (resolvedNominalName nominal) (resolvedNominalLoc nominal)-    }-  where-    moduleName = nominalRepresentationModule ctx (resolvedNominalName nominal)-    representationType = resolvedNominalName nominal <> "Representation"-    encoderName = lowerFirst (resolvedNominalName nominal) <> "RepresentationText"--nominalProjectionModule :: Context -> Text-nominalProjectionModule ctx = case placement ctx of-  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".NominalProjections"-  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated.NominalProjections"--nominalProjectionOwners :: Context -> CheckedService -> [(ScaffoldModule, [Name])]-nominalProjectionOwners ctx service = case nominalProjectionTypes (checkedTypeGraph service) spec of-  [] -> []-  nominals ->-    [ ( ScaffoldModule-          { modulePath = T.unpack (T.replace "." "/" (nominalProjectionModule ctx) <> ".hs"),-            moduleText = emitNominalProjections (checkedLanguageContract service) ctx nominals,-            kind = Generated,-            origin = "context " <> specContext spec <> " nominal scalar projection facade"-          },-        []-      )-    ]-  where-    spec = checkedSpec service--nominalProjectionTypes :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [ResolvedNominalType]-nominalProjectionTypes typeGraphResult spec =-  Map.elems . Map.fromList $-    [ (resolvedNominalName nominal, nominal)-    | aggregate <- [value | NAggregate value <- specNodes spec],-      resolved <- registerTypes aggregate <> commandTypes aggregate,-      AggregateNominal nominal <- [resolved],-      ConsumerNominal {} <- [resolvedNominalOwnership nominal]-    ]-  where-    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec-    registerTypes aggregate =-      [ resolved-      | register <- aggRegs aggregate,-        Right resolved <- [resolveAggregateType symbols (regLoc register) RegisterUse (regType register)]-      ]-    commandTypes aggregate =-      [ resolved-      | command <- aggCommands aggregate,-        field <- cmdFields command,-        Right resolved <- [inferAggregateFieldType symbols aggregate CommandFieldUse field]-      ]--emitNominalProjections :: EffectiveLanguageContract -> Context -> [ResolvedNominalType] -> Text-emitNominalProjections languageContract ctx nominals =-  nl $-    renderGeneratedLanguagePragmas [ExtTypeFamilies]-      <> [ generatedBanner,-           "module " <> moduleName <> " where",-           ""-         ]-      <> map ("import " <>) imports-      <> T.lines (renderPlannedImports importPlan)-      <> [""]-      <> [T.intercalate "\n\n" (map emitNominalProjection nominals)]-  where-    moduleName = nominalProjectionModule ctx-    imports =-      sort . nub $-        [ "Keiki.Core (" <> T.intercalate ", " coreImports <> ")",-          "Keiro.Codec.Nominal (" <> T.intercalate ", " nominalCodecImports <> ")"-        ]-          <> ["Data.KindID qualified as KindID" | any hasId nominals]-          <> ["Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain, validateIdDomainText)" | any hasEnforcedId nominals]-          <> ["Data.List.NonEmpty (NonEmpty (..))" | any hasExactDomain nominals]-          <> ["Data.Text (Text)" | any usesText nominals]-          <> ["Data.Time (UTCTime)" | any (hasScalar NominalTime) nominals]-          -- The four text combinators build the legacy hand-rolled TypeID-          -- pattern and are used only by the unenforced-ID branch; importing-          -- them unconditionally warns under -Wunused-imports whenever every-          -- exact-domain nominal is an enum or an enforced ID.-          <> [ "Keiki.ProjectionDomain ("-                 <> T.intercalate-                   ", "-                   ( ["TextPattern", "finiteProjectionDomain", "matchesTextPattern", "textProjectionDomain"]-                       <> (if any hasUnenforcedId nominals then ["textCharSet", "textConcat", "textLiteral", "textRepeatBetween"] else [])-                   )-                 <> ")"-             | any hasExactDomain nominals-             ]-          <> ["Numeric.Natural (Natural)" | any (hasScalar NominalNatural) nominals]-    hasExactProjection nominal = case resolvedNominalRepresentation nominal of ScalarRepresentation {} -> False; _ -> True-    hasInexactProjection = any (not . hasExactProjection) nominals-    hasReconstruction = any hasExactProjection nominals-    coreImports =-      ["FieldProjection (..)", "FieldWitness"]-        <> (if hasReconstruction then ["ExactFieldProjection (..)", "exactFieldWitness"] else [])-        <> ["fieldWitness" | hasInexactProjection]-    nominalCodecImports =-      ["nominalToRepresentation"]-        <> ["nominalFromRepresentation" | hasReconstruction]-    hasScalar wanted nominal = resolvedNominalRepresentation nominal == ScalarRepresentation wanted-    hasId nominal = case resolvedNominalRepresentation nominal of IdRepresentation {} -> True; _ -> False-    hasEnforcedId nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix)-      _ -> False-    hasUnenforcedId nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> isNothing (idDomainContractFor languageContract prefix)-      _ -> False-    hasExactDomain nominal = case resolvedNominalRepresentation nominal of ScalarRepresentation {} -> False; _ -> True-    usesText nominal = case resolvedNominalRepresentation nominal of ScalarRepresentation NominalText -> True; IdRepresentation {} -> True; EnumRepresentation {} -> True; _ -> False-    importPlan =-      planImportsOrDie-        moduleName-        ( Set.fromList-            [ tagName-            | nominal <- nominals,-              tagName <- case resolvedNominalRepresentation nominal of-                ScalarRepresentation {} -> [resolvedNominalName nominal <> "NominalProjection"]-                IdRepresentation {} -> [nominalEqualityTagName nominal]-                EnumRepresentation {} -> [nominalEqualityTagName nominal]-            ]-        )-        ( Set.fromList-            [ reference-            | nominal <- nominals,-              ConsumerNominal binding <- [resolvedNominalOwnership nominal],-              reference <--                [ haskellTypeReference (consumerNominalHaskell binding),-                  qualifiedValueReference (consumerNominalBinding binding)-                ]-                  <> case resolvedNominalRepresentation nominal of-                    EnumRepresentation constructors ->-                      HaskellReference representationModule (lowerFirst (resolvedNominalName nominal) <> "RepresentationText") ValueNamespace RequireQualified-                        : [ HaskellReference representationModule constructor ConstructorNamespace RequireQualified-                          | (constructor, _) <- NE.toList constructors-                          ]-                      where-                        representationModule = nominalRepresentationModule ctx (resolvedNominalName nominal)-                    _ -> []-            ]-        )-    emitNominalProjection nominal = case resolvedNominalOwnership nominal of-      GeneratedNominal -> ""-      ConsumerNominal binding -> case resolvedNominalRepresentation nominal of-        ScalarRepresentation {} -> emitScalarProjection nominal binding-        IdRepresentation prefix -> emitConsumerIdProjection nominal binding prefix-        EnumRepresentation constructors -> emitConsumerEnumProjection nominal binding constructors-    emitScalarProjection nominal binding =-      nl-        [ "data " <> tagName,-          "",-          "instance FieldProjection " <> tagName <> " where",-          "  type FieldName " <> tagName <> " = " <> tshow name,-          "  type FieldOwner " <> tagName <> " = " <> renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding)),-          "  type FieldResult " <> tagName <> " = " <> scalarHaskellType (resolvedNominalRepresentation nominal),-          "  fieldShapeId _ = " <> tshow (unCanonicalTypeId (consumerNominalCanonical binding)),-          "  projectFieldValue _ = nominalToRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding)),-          "",-          witnessName <> " :: FieldWitness " <> tagName,-          witnessName <> " = fieldWitness @" <> tagName-        ]-      where-        name = resolvedNominalName nominal-        tagName = name <> "NominalProjection"-        witnessName = lowerFirst name <> "Witness"-    emitConsumerIdProjection nominal binding prefix =-      nl-        ( patternLines-            <> [ "",-                 "data " <> tagName,-                 "",-                 "instance FieldProjection " <> tagName <> " where",-                 "  type FieldName " <> tagName <> " = " <> tshow name,-                 "  type FieldOwner " <> tagName <> " = " <> ownerType,-                 "  type FieldResult " <> tagName <> " = Text",-                 "  fieldShapeId _ = " <> tshow equalityIdentity,-                 "  projectFieldValue _ = KindID.toText . nominalToRepresentation " <> bindingName,-                 "",-                 "instance ExactFieldProjection " <> tagName <> " where",-                 "  fieldProjectionDomain _ = textProjectionDomain " <> patternName,-                 "  reconstructFieldOwner _ value"-               ]-            <> validationGuard-            <> [ "    | not (matchesTextPattern " <> patternName <> " value) = Nothing",-                 "    | otherwise = case KindID.parseText @" <> tshow prefix <> " value of",-                 "        Left _ -> Nothing",-                 "        Right representation -> Just (nominalFromRepresentation " <> bindingName <> " representation)",-                 "",-                 witnessName <> " :: FieldWitness " <> tagName,-                 witnessName <> " = exactFieldWitness @" <> tagName-               ]-        )-      where-        name = resolvedNominalName nominal-        tagName = nominalEqualityTagName nominal-        witnessName = nominalEqualityWitnessName nominal-        patternName = lowerFirst name <> "EqualityPattern"-        ownerType = renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding))-        bindingName = renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding))-        equalityIdentity = fromMaybe (error "consumer ID equality contract missing") (nominalEqualityIdentityForService languageContract nominal)-        enforced = isJust (idDomainContractFor languageContract prefix)-        patternLines-          | enforced =-              [ patternName <> " :: TextPattern",-                patternName <> " = either (error . show) id (idDomainTextPattern (typeIdV7Domain " <> tshow prefix <> "))"-              ]-          | otherwise =-              [ patternName <> " :: TextPattern",-                patternName <> " = either (error . show) id $ do",-                "  prefix <- textLiteral " <> tshow (prefix <> "_"),-                "  leading <- textCharSet ('0' :| \"1234567\")",-                "  crockford <- textCharSet ('0' :| \"123456789abcdefghjkmnpqrstvwxyz\")",-                "  suffix <- textRepeatBetween 25 25 crockford",-                "  pure (textConcat (prefix :| [leading, suffix]))"-              ]-        validationGuard =-          [ "    | Left _ <- validateIdDomainText (typeIdV7Domain " <> tshow prefix <> ") value = Nothing"-          | enforced-          ]-    emitConsumerEnumProjection nominal binding constructors =-      nl $-        [ "data " <> tagName,-          "",-          "instance FieldProjection " <> tagName <> " where",-          "  type FieldName " <> tagName <> " = " <> tshow name,-          "  type FieldOwner " <> tagName <> " = " <> ownerType,-          "  type FieldResult " <> tagName <> " = Text",-          "  fieldShapeId _ = " <> tshow equalityIdentity,-          "  projectFieldValue _ = " <> encoderName <> " . nominalToRepresentation " <> bindingName,-          "",-          "instance ExactFieldProjection " <> tagName <> " where",-          "  fieldProjectionDomain _ = finiteProjectionDomain (" <> renderNonEmpty (map (tshow . snd) (NE.toList constructors)) <> ")",-          "  reconstructFieldOwner _ = \\case"-        ]-          <> [ "    " <> tshow wire <> " -> Just (nominalFromRepresentation " <> bindingName <> " " <> representationConstructor constructor <> ")"-             | (constructor, wire) <- NE.toList constructors-             ]-          <> [ "    _ -> Nothing",-               "",-               witnessName <> " :: FieldWitness " <> tagName,-               witnessName <> " = exactFieldWitness @" <> tagName-             ]-      where-        name = resolvedNominalName nominal-        tagName = nominalEqualityTagName nominal-        witnessName = nominalEqualityWitnessName nominal-        ownerType = renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding))-        bindingName = renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding))-        representationModule = nominalRepresentationModule ctx name-        encoderName = renderReferenceOrDie importPlan (HaskellReference representationModule (lowerFirst name <> "RepresentationText") ValueNamespace RequireQualified)-        representationConstructor constructor = renderReferenceOrDie importPlan (HaskellReference representationModule constructor ConstructorNamespace RequireQualified)-        equalityIdentity = fromMaybe (error "consumer enum equality contract missing") (nominalEqualityIdentityForService languageContract nominal)-    scalarHaskellType representation = case representation of-      ScalarRepresentation NominalText -> "Text"-      ScalarRepresentation NominalInt -> "Int"-      ScalarRepresentation NominalNatural -> "Natural"-      ScalarRepresentation NominalBool -> "Bool"-      ScalarRepresentation NominalTime -> "UTCTime"-      IdRepresentation {} -> "()"-      EnumRepresentation {} -> "()"--structuralProjectionModule :: Context -> Text-structuralProjectionModule ctx = structuralPrefix ctx <> "Projections"--emitShape :: Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text-emitShape ctx graph declaration shape =-  nl $-    languagePragmas-      <> [ generatedBanner,-           "module " <> moduleName <> " (" <> shapeType <> " (..)) where",-           ""-         ]-      <> map ("import " <>) imports-      <> T.lines (renderPlannedImports importPlan)-      <> ["" | not (null imports) || not (T.null (renderPlannedImports importPlan))]-      <> [shapeDeclaration]-  where-    moduleName = structuralShapeModule ctx (sdName declaration)-    shapeType = sdName declaration <> "Shape"-    requirements = shapeRequirements ctx graph shape-    languagePragmas = renderGeneratedLanguagePragmas []-    imports =-      sort . nub $-        ["Data.Aeson (Value)" | ReqJson `elem` requirements]-          <> ["Data.Map.Strict (Map)" | ReqMap `elem` requirements]-          <> ["Data.Text (Text)" | ReqText `elem` requirements]-          <> ["Data.Time (UTCTime)" | ReqTime `elem` requirements]-          <> ["GHC.Generics (Generic)"]-          <> ["Numeric.Natural (Natural)" | ReqNatural `elem` requirements]-    shapeDeclaration =-      foldMappedShape-        MappedShapeAlgebra-          { onRecord = \constructor _ fields ->-              nl $-                ["data " <> shapeType <> " = " <> constructor]-                  <> recordFields-                    [ (rwfHaskell field, renderShapeType importPlan ctx graph (rwfType field))-                    | field <- fields-                    ]-                  <> ["  deriving stock (Eq, Generic, Show)"],-            onEnum = \entries ->-              "data "-                <> shapeType-                <> " = "-                <> T.intercalate " | " (map weCtor entries)-                <> "\n  deriving stock (Eq, Generic, Show)",-            onUnion = \_ arms ->-              nl $-                case arms of-                  [] -> ["data " <> shapeType <> " = " <> shapeType <> "Empty", "  deriving stock (Eq, Generic, Show)"]-                  firstArm : rest ->-                    ["data " <> shapeType <> " = " <> renderArm firstArm]-                      <> ["  | " <> renderArm arm | arm <- rest]-                      <> ["  deriving stock (Eq, Generic, Show)"]-          }-        shape-    renderArm arm = rwaCtor arm <> maybe "" ((" !" <>) . renderShapeType importPlan ctx graph) (rwaPayload arm)-    importPlan =-      planImportsOrDie-        moduleName-        (Set.singleton shapeType)-        (Set.fromList [reference | ReqReference reference <- requirements])--data ShapeRequirement-  = ReqJson-  | ReqMap-  | ReqText-  | ReqTime-  | ReqNatural-  | ReqReference !HaskellReference-  deriving stock (Eq, Ord, Show)--shapeRequirements :: Context -> TypeGraph -> ResolvedMappedShape -> [ShapeRequirement]-shapeRequirements ctx graph =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \_ _ fields -> concatMap (exprRequirements ctx graph . rwfType) fields,-        onEnum = const [],-        onUnion = \_ arms -> concatMap (maybe [] (exprRequirements ctx graph) . rwaPayload) arms-      }--exprRequirements :: Context -> TypeGraph -> ResolvedTypeExpr -> [ShapeRequirement]-exprRequirements ctx graph =-  foldTypeExpr-    TypeExprAlgebra-      { onText = [ReqText],-        onInt = [],-        onInteger = [],-        onBool = [],-        onNatural = [ReqNatural],-        onTime = [ReqTime],-        onJson = [ReqJson],-        onOptional = id,-        onList = id,-        onMap = (ReqMap :) . (ReqText :),-        onRef = \key -> case Map.lookup key (tgDeclarations graph) of-          Just (ResolvedStructural declaration _) ->-            [ ReqReference-                ( HaskellReference-                    (structuralShapeModule ctx (sdName declaration))-                    (sdName declaration <> "Shape")-                    TypeNamespace-                    RequireQualified-                )-            ]-          Just (ResolvedOpaque declaration) -> [ReqReference (haskellTypeReference (odHaskell declaration))]-          Nothing -> []-      }--renderShapeType :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedTypeExpr -> Text-renderShapeType importPlan ctx graph =-  renderStrictOrApplicationArgument-    . foldTypeExpr-      TypeExprAlgebra-        { onText = atomicShapeType "Text",-          onInt = atomicShapeType "Int",-          onInteger = atomicShapeType "Integer",-          onBool = atomicShapeType "Bool",-          onNatural = atomicShapeType "Natural",-          onTime = atomicShapeType "UTCTime",-          onJson = atomicShapeType "Value",-          onOptional = applicationShapeType . ("Maybe " <>) . renderStrictOrApplicationArgument,-          onList = atomicShapeType . ("[" <>) . (<> "]") . renderedShapeTypeText,-          onMap = applicationShapeType . ("Map Text " <>) . renderStrictOrApplicationArgument,-          onRef =-            atomicShapeType . \key -> case Map.lookup key (tgDeclarations graph) of-              Just (ResolvedStructural nested _) ->-                renderReferenceOrDie-                  importPlan-                  (HaskellReference (structuralShapeModule ctx (sdName nested)) (sdName nested <> "Shape") TypeNamespace RequireQualified)-              Just (ResolvedOpaque opaque) ->-                renderReferenceOrDie importPlan (haskellTypeReference (odHaskell opaque))-              Nothing -> "()"-        }--data ShapeTypePrecedence-  = AtomicShapeType-  | ApplicationShapeType--data RenderedShapeType = RenderedShapeType-  { renderedShapeTypePrecedence :: !ShapeTypePrecedence,-    renderedShapeTypeText :: !Text-  }--atomicShapeType :: Text -> RenderedShapeType-atomicShapeType = RenderedShapeType AtomicShapeType--applicationShapeType :: Text -> RenderedShapeType-applicationShapeType = RenderedShapeType ApplicationShapeType--renderStrictOrApplicationArgument :: RenderedShapeType -> Text-renderStrictOrApplicationArgument rendered = case renderedShapeTypePrecedence rendered of-  AtomicShapeType -> renderedShapeTypeText rendered-  ApplicationShapeType -> "(" <> renderedShapeTypeText rendered <> ")"--data StructuralProjection = StructuralProjection-  { spTag :: !Text,-    spWitness :: !Text,-    spPointer :: !Text,-    spOwner :: !HaskellSource,-    spResult :: !Text,-    spCanonical :: !CanonicalTypeId,-    spBinding :: !QualifiedValueName,-    spSelectors :: ![(Text, Text)]-  }-  deriving stock (Eq, Show)--projectionSpecs :: TypeGraph -> [StructuralProjection]-projectionSpecs graph =-  sortOn spTag . allocateProjectionNames . concat $-    [ projectionsForRoot graph declaration shape-    | ResolvedStructural declaration shape <- Map.elems (tgDeclarations graph)-    ]--projectionsForRoot :: TypeGraph -> StructuralDecl -> ResolvedMappedShape -> [StructuralProjection]-projectionsForRoot graph root rootShape = case rootShape of-  RRecord _ _ fields -> concatMap (walkField [] []) fields-  REnum {} -> []-  RUnion {} -> []-  where-    walkField keys selectors field-      | rwfPresence field /= PRequired = []-      | otherwise = case projectionScalar (rwfType field) of-          Just result -> [mkProjection (keys <> [rwfKey field]) (selectors <> [(shapeModuleForOwner, rwfHaskell field)]) result]-          Nothing -> case rwfType field of-            RRef key -> case Map.lookup key (tgDeclarations graph) of-              Just (ResolvedStructural nested (RRecord _ _ nestedFields)) ->-                concatMap-                  (walkNested nested (keys <> [rwfKey field]) (selectors <> [(shapeModuleForOwner, rwfHaskell field)]))-                  nestedFields-              _ -> []-            _ -> []-      where-        shapeModuleForOwner = "__SHAPE__." <> sdName root--    walkNested owner keys selectors field-      | rwfPresence field /= PRequired = []-      | otherwise = case projectionScalar (rwfType field) of-          Just result -> [mkProjection (keys <> [rwfKey field]) (selectors <> [(shapeModuleFor owner, rwfHaskell field)]) result]-          Nothing -> case rwfType field of-            RRef key -> case Map.lookup key (tgDeclarations graph) of-              Just (ResolvedStructural nested (RRecord _ _ nestedFields)) ->-                concatMap-                  (walkNested nested (keys <> [rwfKey field]) (selectors <> [(shapeModuleFor owner, rwfHaskell field)]))-                  nestedFields-              _ -> []-            _ -> []--    -- Context is supplied when rendering; this marker is replaced there.-    shapeModuleFor declaration = "__SHAPE__." <> sdName declaration-    mkProjection keys selectors result =-      StructuralProjection-        { spTag = nameStem <> "Projection",-          spWitness = lowerFirst nameStem <> "Witness",-          spPointer = pointer,-          spOwner = sdHaskell root,-          spResult = result,-          spCanonical = sdCanonical root,-          spBinding = sdBinding root,-          spSelectors = selectors-        }-      where-        pointer = T.concat ["/" <> escapePointer key | key <- keys]-        nameStem = projectionNameStem (sdName root) pointer--projectionScalar :: ResolvedTypeExpr -> Maybe Text-projectionScalar = \case-  RText -> Just "Text"-  RInt -> Just "Int"-  RInteger -> Just "Integer"-  RBool -> Just "Bool"-  RTime -> Just "UTCTime"-  RNatural -> Just "Natural"-  RJson -> Nothing-  ROptional {} -> Nothing-  RList {} -> Nothing-  RMap {} -> Nothing-  RRef {} -> Nothing--escapePointer :: Text -> Text-escapePointer = T.replace "/" "~1" . T.replace "~" "~0"--projectionNameStem :: Name -> Text -> Text-projectionNameStem owner pointer =-  pascal owner-    <> T.concat-      [ normaliseAliasPart (unescapePointer segment)-      | segment <- filter (not . T.null) (T.splitOn "/" pointer)-      ]---- | Add a stable digest only when two distinct wire paths normalize to the--- same Haskell name. Digest collisions receive a deterministic ordinal, so the--- emitter never produces duplicate declarations even in that unlikely case.-allocateProjectionNames :: [StructuralProjection] -> [StructuralProjection]-allocateProjectionNames specs = concatMap allocateGroup groups-  where-    groups = groupBy (\left right -> spTag left == spTag right) (sortOn spTag specs)-    allocateGroup [spec] = [spec]-    allocateGroup collided = reverse named-      where-        ordered = sortOn projectionIdentity collided-        digest spec = T.take 8 (fnv1a64 (projectionIdentity spec))-        digestCounts = Map.fromListWith (+) [(digest spec, 1 :: Int) | spec <- ordered]-        (_, named) = foldl allocate (Map.empty, []) ordered-        allocate (seen, allocated) spec =-          let shortDigest = digest spec-              occurrence = Map.findWithDefault 0 shortDigest seen + 1-              suffix =-                shortDigest-                  <> if Map.findWithDefault 0 shortDigest digestCounts == 1-                    then ""-                    else tshow' occurrence-           in (Map.insert shortDigest occurrence seen, renameWithSuffix suffix spec : allocated)-    projectionIdentity spec = unCanonicalTypeId (spCanonical spec) <> "#" <> spPointer spec-    renameWithSuffix suffix spec =-      spec-        { spTag = nameStem <> suffix <> "Projection",-          spWitness = lowerFirst nameStem <> suffix <> "Witness"-        }-      where-        nameStem = fromMaybe (spTag spec) (T.stripSuffix "Projection" (spTag spec))--projectionWitnessName :: TypeGraph -> MappedKey -> Text -> Maybe Text-projectionWitnessName graph owner pointer = do-  ResolvedStructural declaration _ <- Map.lookup owner (tgDeclarations graph)-  spWitness-    <$> find-      (\spec -> spCanonical spec == sdCanonical declaration && spPointer spec == pointer)-      (projectionSpecs graph)--emitStructuralProjections :: Context -> TypeGraph -> Text-emitStructuralProjections ctx graph =-  nl $-    renderGeneratedLanguagePragmas [ExtTypeFamilies | not (null specs)]-      <> [ generatedBanner,-           "-- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.",-           "-- Int, Natural, and UTCTime belong to Keiki's ordered subset.",-           "module " <> moduleName,-           "  ( " <> T.intercalate "\n  , " (map spWitness specs),-           "  ) where",-           ""-         ]-      <> staticImports-      <> T.lines (renderPlannedImports importPlan)-      <> concatMap renderProjection specs-  where-    moduleName = structuralProjectionModule ctx-    specs = map (resolveProjectionModules ctx) (projectionSpecs graph)-    resultTypes = Set.fromList (map spResult specs)-    staticImports =-      ["import Data.Text (Text)" | "Text" `Set.member` resultTypes]-        <> ["import Data.Time (UTCTime)" | "UTCTime" `Set.member` resultTypes]-        <> ["import Numeric.Natural (Natural)" | "Natural" `Set.member` resultTypes]-        <> ["import Keiro.Codec.Structural (bindingToShape)" | not (null specs)]-        <> ["import Keiki.Core (FieldProjection (..), FieldWitness, fieldWitness)" | not (null specs)]-    importPlan =-      planImportsOrDie-        moduleName-        (Set.fromList (map spTag specs))-        ( Set.fromList-            ( [haskellTypeReference (spOwner spec) | spec <- specs]-                <> [qualifiedValueReference (spBinding spec) | spec <- specs]-                <> [ HaskellReference shapeModuleName selector ValueNamespace RequireQualified-                   | spec <- specs,-                     (shapeModuleName, selector) <- spSelectors spec-                   ]-            )-        )-    renderProjection spec =-      [ "",-        "data " <> spTag spec,-        "",-        "instance FieldProjection " <> spTag spec <> " where",-        "  type FieldName " <> spTag spec <> " = " <> tshow (spPointer spec),-        "  type FieldOwner " <> spTag spec <> " = " <> renderReferenceOrDie importPlan (haskellTypeReference (spOwner spec)),-        "  type FieldResult " <> spTag spec <> " = " <> spResult spec,-        "  fieldShapeId _ = " <> tshow (unCanonicalTypeId (spCanonical spec)),-        "  projectFieldValue _ owner = " <> renderGetter spec,-        "",-        spWitness spec <> " :: FieldWitness " <> spTag spec,-        spWitness spec <> " = fieldWitness @" <> spTag spec-      ]-    renderGetter spec =-      foldl-        ( \value (shapeModuleName, selector) ->-            renderReferenceOrDie importPlan (HaskellReference shapeModuleName selector ValueNamespace RequireQualified)-              <> " ("-              <> value-              <> ")"-        )-        ("bindingToShape " <> renderReferenceOrDie importPlan (qualifiedValueReference (spBinding spec)) <> " owner")-        (spSelectors spec)--resolveProjectionModules :: Context -> StructuralProjection -> StructuralProjection-resolveProjectionModules ctx spec =-  spec-    { spSelectors =-        [ (replaceModule marker, selector)-        | (marker, selector) <- spSelectors spec-        ]-    }-  where-    replaceModule marker-      | Just name <- T.stripPrefix "__SHAPE__." marker = structuralShapeModule ctx name-      | otherwise = structuralShapeModule ctx (lastSegment marker)--haskellTypeReference :: HaskellSource -> HaskellReference-haskellTypeReference source =-  HaskellReference (hsModule source) (hsType source) TypeNamespace PreferUnqualified--qualifiedValueReference :: QualifiedValueName -> HaskellReference-qualifiedValueReference qualified =-  HaskellReference moduleName valueName ValueNamespace RequireQualified-  where-    (moduleName, valueName) = splitQualified (unQualifiedValueName qualified)--renderReferenceOrDie :: HaskellImportPlan -> HaskellReference -> Text-renderReferenceOrDie importPlan =-  either-    (error . ("validated Haskell reference failed: " <>) . show)-    id-    . renderPlannedReference importPlan--planImportsOrDie :: Text -> Set.Set Text -> Set.Set HaskellReference -> HaskellImportPlan-planImportsOrDie target localDeclarations =-  either-    (error . ("validated Haskell import planning failed: " <>) . show)-    id-    . planHaskellImports-      ImportEnvironment-        { targetModule = target,-          localNames = localDeclarations,-          reservedQualifiers = rendererReservedQualifiers-        }--rendererReservedQualifiers :: Set.Set Text-rendererReservedQualifiers =-  Set.fromList-    [ "Aeson",-      "AesonKey",-      "AesonKeyMap",-      "B",-      "GeneratedNominals",-      "Holes",-      "K",-      "Key",-      "KeyMap",-      "KindID",-      "Map",-      "NominalProjections",-      "NonEmpty",-      "S",-      "Set",-      "StructuralProjections",-      "T"-    ]--splitQualified :: Text -> (Text, Text)-splitQualified value =-  let (prefix, name) = T.breakOnEnd "." value-   in (T.dropEnd 1 prefix, name)--lastSegment :: Text -> Text-lastSegment = snd . T.breakOnEnd "."---- | Emit all modules for one aggregate. The 'Spec' is needed for the shared--- id\/enum declarations.-scaffoldAggregate :: Context -> Spec -> Aggregate -> [ScaffoldModule]-scaffoldAggregate ctx spec = scaffoldAggregateForService ctx (legacyCheckedService spec)---- | Emit all modules for one aggregate after selecting the effective semantic--- contract. This is the normal source/workspace generation entry point.-scaffoldAggregateForService :: Context -> CheckedService -> Aggregate -> [ScaffoldModule]-scaffoldAggregateForService ctx service agg =-  [ genModule a "Domain" (emitDomain a),-    genModule a "Codec" (emitCodec a)-  ]-    ++ ( if hasVersion2Ownership a-           then-             [ genModule a "Transducer" (emitGeneratedTransducer a),-               genModule a "BehaviorContract" (emitBehaviorContract a),-               behaviorHoleModule a-             ]-           else []-       )-    ++ [ genModule a "EventStream" (emitEventStream a),-         genModule a "Projection" (emitProjection a)-       ]-    ++ [holeModule a (emitHoles a) | aggregateNeedsHoleModule a]-  where-    a = resolveAggForService ctx service agg--aggregateNeedsHoleModule :: Agg -> Bool-aggregateNeedsHoleModule aggregate-  | hasVersion2Ownership aggregate = not (null (version2HoleExports aggregate))-  | otherwise = True---- | The generated behavioral contract is deliberately separate from both the--- authoritative transducer and the create-once witness list.  Regeneration can--- replace this module freely while stale textual keys in @BehaviorHoles@ keep--- compiling and are reported by reconciliation.-emitBehaviorContract :: Agg -> Text-emitBehaviorContract aggregate =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedLabels | not (null (aRegs aggregate))]-      <> [ generatedBanner,-           "module " <> aGenPrefix aggregate <> ".BehaviorContract",-           "  ( BehaviorKey (..)",-           "  , ObligationKind (..)",-           "  , EvidenceLevel (..)",-           "  , GuardCoverage (..)",-           "  , BehaviorRequirement (..)",-           "  , RejectionClass (..)",-           "  , LiveExpectation (..)",-           "  , BehaviorWitness (..)",-           "  , BehaviorFailure (..)",-           "  , BehaviorConformanceReport (..)",-           "  , behaviorRequirements",-           "  , behaviorCoverageReport",-           "  , behaviorConformancePassed",-           "  , behaviorConformancePassedWith",-           "  , renderBehaviorConformanceText",-           "  ) where",-           "",-           "import " <> aGenPrefix aggregate <> ".Codec (encode" <> name <> "Event, parse" <> name <> "Event, " <> valueStem <> "Codec)",-           "import " <> aGenPrefix aggregate <> ".Domain",-           "import " <> aGenPrefix aggregate <> ".Transducer (" <> valueStem <> "Transducer)",-           "import " <> contextGeneratedPrefix (aContext aggregate) <> ".BehaviorSourceMap qualified as BehaviorSourceMap"-         ]-      <> outcomeBehaviorImports-      <> [ "import Data.Aeson (ToJSON (..), object, (.=))",-           "import Data.List (sortOn)",-           "import Data.List.NonEmpty (NonEmpty)",-           "import Data.List.NonEmpty qualified as NonEmpty",-           "import Data.Map.Strict qualified as Map",-           "import Data.Text (Text)",-           "import Data.Text qualified as T",-           "import Keiki.Core qualified as K (" <> T.intercalate ", " behaviorCoreImports <> ")",-           "import Keiro.Codec qualified as Codec (Codec (eventType), EventType (..))",-           "",-           "newtype BehaviorKey = BehaviorKey { unBehaviorKey :: Text }",-           "  deriving stock (Eq, Ord, Show)",-           "",-           "data ObligationKind = LiveTransition | RequiredRejection | ReplayTransition",-           "  deriving stock (Eq, Ord, Show)",-           "",-           "data EvidenceLevel = GeneratedAuthoritative | HoleWitnessed | LegacyRuntimeWitness",-           "  deriving stock (Eq, Ord, Show)",-           "",-           "data GuardCoverage = GuardTotal | GuardPartial | GuardUnknown | GuardNotApplicable",-           "  deriving stock (Eq, Ord, Show)",-           "",-           "data BehaviorRequirement = BehaviorRequirement",-           "  { requirementKey :: !BehaviorKey",-           "  , requirementKind :: !ObligationKind",-           "  , requirementEvidence :: !EvidenceLevel",-           "  , requirementGuardCoverage :: !GuardCoverage",-           "  , requirementSource :: !" <> aVertexType aggregate,-           "  , requirementCommandName :: !Text",-           "  , requirementExpectedEdge :: !(Maybe (K.EdgeRef " <> aVertexType aggregate <> "))",-           "  , requirementTarget :: !(Maybe " <> aVertexType aggregate <> ")",-           "  , requirementEventKinds :: ![Text]",-           "  }",-           "  deriving stock (Eq, Show)",-           "",-           "data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge",-           "  deriving stock (Eq, Show)",-           "",-           "data LiveExpectation",-           "  = Emits (NonEmpty " <> name <> "Event)",-           "  | Rejects RejectionClass"-         ]-      <> outcomeExpectationConstructors-      <> [ "  | NoOp",-           "  deriving stock (Eq, Show)",-           "",-           "data BehaviorWitness",-           "  = Pending BehaviorKey",-           "  | LiveWitness",-           "      { witnessKey :: BehaviorKey",-           "      , witnessHistory :: [" <> name <> "Event]",-           "      , witnessCommand :: " <> name <> "Command",-           "      , witnessExpected :: LiveExpectation",-           "      }",-           "  | ReplayWitness",-           "      { witnessKey :: BehaviorKey",-           "      , witnessHistoryPrefix :: [" <> name <> "Event]",-           "      , witnessObservedChunk :: [" <> name <> "Event]",-           "      }",-           "  deriving stock (Eq, Show)",-           "",-           "data BehaviorFailure = BehaviorFailure",-           "  { failureKey :: !BehaviorKey",-           "  , failureSubject :: !Text",-           "  , failureCode :: !Text",-           "  , failureDetail :: !Text",-           "  }",-           "  deriving stock (Eq, Show)",-           "",-           "instance ToJSON BehaviorFailure where",-           "  toJSON behaviorFailure = object",-           "    [ \"key\" .= unBehaviorKey (failureKey behaviorFailure)",-           "    , \"subject\" .= failureSubject behaviorFailure",-           "    , \"code\" .= failureCode behaviorFailure",-           "    , \"detail\" .= failureDetail behaviorFailure",-           "    ]",-           "",-           "data BehaviorConformanceReport = BehaviorConformanceReport",-           "  { reportRequired :: ![BehaviorKey]",-           "  , reportFilled :: ![BehaviorKey]",-           "  , reportPending :: ![BehaviorKey]",-           "  , reportMissing :: ![BehaviorKey]",-           "  , reportDuplicate :: ![BehaviorKey]",-           "  , reportStale :: ![BehaviorKey]",-           "  , reportFailed :: ![BehaviorFailure]",-           "  , reportVerified :: ![BehaviorKey]",-           "  , reportUnverified :: ![BehaviorKey]",-           "  }",-           "  deriving stock (Eq, Show)",-           "",-           "instance ToJSON BehaviorConformanceReport where",-           "  toJSON report = object",-           "    [ \"schema\" .= (\"keiro/behavior-conformance/1\" :: Text)",-           "    , \"required\" .= keyTexts (reportRequired report)",-           "    , \"filled\" .= keyTexts (reportFilled report)",-           "    , \"pending\" .= keyTexts (reportPending report)",-           "    , \"missing\" .= keyTexts (reportMissing report)",-           "    , \"duplicate\" .= keyTexts (reportDuplicate report)",-           "    , \"stale\" .= keyTexts (reportStale report)",-           "    , \"failed\" .= reportFailed report",-           "    , \"verified\" .= keyTexts (reportVerified report)",-           "    , \"unverified\" .= keyTexts (reportUnverified report)",-           "    ]",-           "",-           "behaviorRequirements :: [BehaviorRequirement]",-           "behaviorRequirements ="-         ]-      <> renderBehaviorRequirementList aggregate-      <> [ "",-           "behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport",-           "behaviorCoverageReport witnesses =",-           "  BehaviorConformanceReport",-           "    { reportRequired = sortedKeys (Map.keys requiredByKey)",-           "    , reportFilled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]",-           "    , reportPending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]",-           "    , reportMissing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]",-           "    , reportDuplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]",-           "    , reportStale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]",-           "    , reportFailed = sortOn (unBehaviorKey . failureKey) failures",-           "    , reportVerified = sortedKeys [requirementKey requirement | (requirement, Right ()) <- executions, proofStrength requirement]",-           "    , reportUnverified = sortedKeys [requirementKey requirement | (requirement, Right ()) <- executions, not (proofStrength requirement)]",-           "    }",-           " where",-           "  requiredByKey = Map.fromList [(requirementKey requirement, requirement) | requirement <- behaviorRequirements]",-           "  witnessGroups = Map.fromListWith (flip (<>)) [(behaviorWitnessKey witness, [witness]) | witness <- witnesses]",-           "  executions =",-           "    [ (requirement, runWitness requirement witness)",-           "    | (key, [witness]) <- Map.toList witnessGroups",-           "    , not (isPending witness)",-           "    , Just requirement <- [Map.lookup key requiredByKey]",-           "    ]",-           "  failures = [behaviorFailure | (_, Left behaviorFailure) <- executions]",-           "",-           "behaviorConformancePassed :: BehaviorConformanceReport -> Bool",-           "behaviorConformancePassed = behaviorConformancePassedWith False",-           "",-           "behaviorConformancePassedWith :: Bool -> BehaviorConformanceReport -> Bool",-           "behaviorConformancePassedWith failOnUnverified report =",-           "  null (reportPending report)",-           "    && null (reportMissing report)",-           "    && null (reportDuplicate report)",-           "    && null (reportStale report)",-           "    && null (reportFailed report)",-           "    && (not failOnUnverified || null (reportUnverified report))",-           "",-           "renderBehaviorConformanceText :: BehaviorConformanceReport -> Text",-           "renderBehaviorConformanceText report = T.unlines",-           "  [ \"behavior conformance: " <> name <> "\"",-           "  , \"schema: keiro/behavior-conformance/1\"",-           "  , countLine \"required\" (reportRequired report)",-           "  , countLine \"filled\" (reportFilled report)",-           "  , countLine \"pending\" (reportPending report)",-           "  , countLine \"missing\" (reportMissing report)",-           "  , countLine \"duplicate\" (reportDuplicate report)",-           "  , countLine \"stale\" (reportStale report)",-           "  , \"failed: \" <> tshow (length (reportFailed report))",-           "  , countLine \"verified\" (reportVerified report)",-           "  , countLine \"unverified\" (reportUnverified report)",-           "  ] <> T.unlines [\"FAIL \" <> unBehaviorKey (failureKey behaviorFailure) <> \" \" <> failureSubject behaviorFailure <> \" [\" <> failureCode behaviorFailure <> \"] \" <> failureDetail behaviorFailure | behaviorFailure <- reportFailed report]",-           "",-           "runWitness :: BehaviorRequirement -> BehaviorWitness -> Either BehaviorFailure ()",-           "runWitness requirement witness = case witness of",-           "  Pending _ -> failure requirement \"pending\" \"witness is still Pending\"",-           "  LiveWitness _ history command expectation -> runLive requirement history command expectation",-           "  ReplayWitness _ prefix chunk -> runReplay requirement prefix chunk",-           "",-           "runLive :: BehaviorRequirement -> [" <> name <> "Event] -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",-           "runLive requirement history command expectation = do",-           "  settled <- settleHistory requirement \"history\" history",-           "  ensure requirement (K.replaySuccessState settled == requirementSource requirement) \"history-wrong-source\" \"history does not settle at the required source vertex\"",-           "  ensure requirement (commandKind command == requirementCommandName requirement) \"command-mismatch\" \"witness command constructor does not match the required state/command cell\"",-           "  case requirementKind requirement of",-           "    ReplayTransition -> failure requirement \"witness-kind\" \"a replay-only requirement needs ReplayWitness\"",-           "    RequiredRejection -> runRejection requirement (K.replaySuccessState settled, K.replaySuccessRegs settled) command expectation",-           "    LiveTransition -> runAcceptance requirement (K.replaySuccessState settled, K.replaySuccessRegs settled) command expectation",-           "",-           "runRejection :: BehaviorRequirement -> (" <> aVertexType aggregate <> ", K.RegFile " <> name <> "Regs) -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",-           "runRejection requirement seed command expectation = case expectation of",-           "  Emits _ -> failure requirement \"expectation-kind\" \"a rejection requirement cannot expect emitted events\""-         ]-      <> outcomeGenericRejectionCases-      <> [ "  NoOp -> failure requirement \"expectation-kind\" \"a rejection requirement cannot expect an accepted no-op\"",-           "  Rejects expectedClass -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",-           "    Left K.NoOutgoingEdges {} -> ensure requirement (expectedClass == RejectNoOutgoingEdges) \"rejection-class\" \"expected NoMatchingEdge but runtime returned NoOutgoingEdges\"",-           "    Left K.NoMatchingEdge {} -> ensure requirement (expectedClass == RejectNoMatchingEdge) \"rejection-class\" \"expected NoOutgoingEdges but runtime returned NoMatchingEdge\"",-           "    Left K.AmbiguousEdges {} -> failure requirement \"ambiguous-edges\" \"AmbiguousEdges can never satisfy a rejection witness\"",-           "    Right _ -> failure requirement \"unexpected-acceptance\" \"runtime accepted a command required to reject\"",-           "",-           "runAcceptance :: BehaviorRequirement -> (" <> aVertexType aggregate <> ", K.RegFile " <> name <> "Regs) -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",-           "runAcceptance requirement seed command expectation = case expectation of",-           "  Rejects _ -> failure requirement \"expectation-kind\" \"a live-transition requirement needs Emits or NoOp\""-         ]-      <> outcomeExactAcceptanceCases-      <> genericNoOpAcceptanceLines-      <> [ "  Emits expectedEvents -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",-           "    Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",-           "    Right success -> do",-           "      checkAcceptedEnvelope requirement success",-           "      let expected = NonEmpty.toList expectedEvents",-           "          actual = K.stepSuccessOutputs success",-           "      ensure requirement (actual == expected) \"event-value-mismatch\" (\"runtime event values differ from the exact witness expectation; actual=\" <> tshow actual <> \" expected=\" <> tshow expected)",-           "      ensure requirement (map eventKind actual == requirementEventKinds requirement) \"event-envelope-mismatch\" (\"runtime event kinds differ from the declared ordered envelope; actual=\" <> tshow (map eventKind actual) <> \" expected=\" <> tshow (requirementEventKinds requirement))",-           "      decoded <- either (failure requirement \"emitted-codec-decode\") Right (decodeEvents actual)",-           "      replayed <- case K.applyEventsDetailedEither " <> valueStem <> "Transducer seed decoded of",-           "        Left replayFailure -> failure requirement \"emitted-replay-failed\" (tshow replayFailure)",-           "        Right replaySuccess -> Right replaySuccess",-           "      ensure requirement (K.replaySuccessState replayed == K.stepSuccessState success) \"forward-replay-vertex\" \"decoded emissions replay to a different vertex\"",-           "      ensure requirement (regsEqual (K.replaySuccessRegs replayed) (K.stepSuccessRegs success)) \"forward-replay-registers\" \"decoded emissions replay to different registers\"",-           "      checkSingleAttribution requirement K.Live (length decoded) (K.replaySuccessTrace replayed)"-         ]-      <> outcomeSilentRunnerLines-      <> [ "",-           "checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess " <> name <> "Regs " <> aVertexType aggregate <> " " <> name <> "Event -> Either BehaviorFailure ()",-           "checkAcceptedEnvelope requirement success = do",-           "  ensure requirement (K.stepSuccessMode success == K.Live) \"forward-mode\" (\"forward execution selected a non-live edge; actual=\" <> tshow (K.stepSuccessMode success) <> \" expected=\" <> tshow K.Live)",-           "  ensure requirement (Just (K.stepSuccessEdge success) == requirementExpectedEdge requirement) \"edge-attribution\" (\"runtime selected a different guarded sibling; actual=\" <> tshow (Just (K.stepSuccessEdge success)) <> \" expected=\" <> tshow (requirementExpectedEdge requirement))",-           "  ensure requirement (Just (K.stepSuccessState success) == requirementTarget requirement) \"target-mismatch\" (\"runtime reached a different target vertex; actual=\" <> tshow (Just (K.stepSuccessState success)) <> \" expected=\" <> tshow (requirementTarget requirement))",-           "",-           "runReplay :: BehaviorRequirement -> [" <> name <> "Event] -> [" <> name <> "Event] -> Either BehaviorFailure ()",-           "runReplay requirement prefix chunk = case requirementKind requirement of",-           "  ReplayTransition -> do",-           "    settled <- settleHistory requirement \"history-prefix\" prefix",-           "    ensure requirement (K.replaySuccessState settled == requirementSource requirement) \"history-wrong-source\" \"history prefix does not settle at the replay edge source\"",-           "    ensure requirement (not (null chunk)) \"empty-replay-chunk\" \"a replay-only edge has no observable empty chunk\"",-           "    decoded <- either (failure requirement \"replay-chunk-codec-decode\") Right (decodeEvents chunk)",-           "    replayed <- case K.applyEventsDetailedEither " <> valueStem <> "Transducer (K.replaySuccessState settled, K.replaySuccessRegs settled) decoded of",-           "      Left replayFailure -> failure requirement \"replay-chunk-failed\" (tshow replayFailure)",-           "      Right replaySuccess -> Right replaySuccess",-           "    ensure requirement (Just (K.replaySuccessState replayed) == requirementTarget requirement) \"target-mismatch\" (\"replay chunk reached a different target vertex; actual=\" <> tshow (Just (K.replaySuccessState replayed)) <> \" expected=\" <> tshow (requirementTarget requirement))",-           "    checkSingleAttribution requirement K.ReplayOnly (length decoded) (K.replaySuccessTrace replayed)",-           "  _ -> failure requirement \"witness-kind\" \"ReplayWitness supplied for a non-replay requirement\"",-           "",-           "checkSingleAttribution :: BehaviorRequirement -> K.EdgeMode -> Int -> [K.ReplayAttribution " <> aVertexType aggregate <> "] -> Either BehaviorFailure ()",-           "checkSingleAttribution requirement expectedMode eventCount trace = case trace of",-           "  [attribution] -> do",-           "    ensure requirement (Just (K.replayAttributionEdge attribution) == requirementExpectedEdge requirement) \"replay-edge-attribution\" (\"replay selected a different edge; actual=\" <> tshow (Just (K.replayAttributionEdge attribution)) <> \" expected=\" <> tshow (requirementExpectedEdge requirement))",-           "    ensure requirement (K.replayAttributionMode attribution == expectedMode) \"replay-mode-attribution\" (\"replay selected the wrong live/replay-only phase; actual=\" <> tshow (K.replayAttributionMode attribution) <> \" expected=\" <> tshow expectedMode)",-           "    ensure requirement (K.replayAttributionSource attribution == requirementSource requirement) \"replay-source-attribution\" (\"replay attribution starts at the wrong source; actual=\" <> tshow (K.replayAttributionSource attribution) <> \" expected=\" <> tshow (requirementSource requirement))",-           "    ensure requirement (Just (K.replayAttributionTarget attribution) == requirementTarget requirement) \"replay-target-attribution\" (\"replay attribution ends at the wrong target; actual=\" <> tshow (Just (K.replayAttributionTarget attribution)) <> \" expected=\" <> tshow (requirementTarget requirement))",-           "    ensure requirement (K.replayAttributionSpan attribution == K.ReplayEventSpan 0 eventCount) \"replay-span-attribution\" (\"replay attribution did not consume the exact chunk; actual=\" <> tshow (K.replayAttributionSpan attribution) <> \" expected=\" <> tshow (K.ReplayEventSpan 0 eventCount))",-           "  _ -> failure requirement \"replay-trace-cardinality\" \"expected exactly one completed-edge attribution\"",-           "",-           "settleHistory :: BehaviorRequirement -> Text -> [" <> name <> "Event] -> Either BehaviorFailure (K.ReplaySuccess " <> name <> "Regs " <> aVertexType aggregate <> ")",-           "settleHistory requirement label history = do",-           "  decoded <- either (failure requirement (label <> \"-codec-decode\")) Right (decodeEvents history)",-           "  case K.applyEventsDetailedEither " <> valueStem <> "Transducer (" <> initialVertex aggregate <> ", initial" <> name <> "Regs) decoded of",-           "    Left replayFailure -> failure requirement (label <> \"-replay-failed\") (tshow replayFailure)",-           "    Right replaySuccess -> Right replaySuccess",-           "",-           "decodeEvents :: [" <> name <> "Event] -> Either Text [" <> name <> "Event]",-           "decodeEvents = traverse (\\event -> parse" <> name <> "Event (Codec.eventType " <> valueStem <> "Codec event) (encode" <> name <> "Event event))"-         ]-      <> renderCommandKind aggregate-      <> [ "",-           "eventKind :: " <> name <> "Event -> Text",-           "eventKind event = case Codec.eventType " <> valueStem <> "Codec event of Codec.EventType tag -> tag",-           "",-           "regsEqual :: K.RegFile " <> name <> "Regs -> K.RegFile " <> name <> "Regs -> Bool",-           regsEqualityExpression aggregate,-           "",-           "proofStrength :: BehaviorRequirement -> Bool",-           "proofStrength requirement =",-           "  requirementEvidence requirement == GeneratedAuthoritative",-           "    && requirementGuardCoverage requirement `elem` [GuardTotal, GuardNotApplicable]",-           "",-           "behaviorWitnessKey :: BehaviorWitness -> BehaviorKey",-           "behaviorWitnessKey witness = case witness of",-           "  Pending key -> key",-           "  LiveWitness { witnessKey = key } -> key",-           "  ReplayWitness { witnessKey = key } -> key",-           "",-           "isPending :: BehaviorWitness -> Bool",-           "isPending Pending {} = True",-           "isPending _ = False",-           "",-           "ensure :: BehaviorRequirement -> Bool -> Text -> Text -> Either BehaviorFailure ()",-           "ensure requirement condition code detail = if condition then Right () else failure requirement code detail",-           "failure :: BehaviorRequirement -> Text -> Text -> Either BehaviorFailure failed",-           "failure requirement code detail =",-           "  Left",-           "    ( BehaviorFailure",-           "        (requirementKey requirement)",-           "        (tshow (requirementSource requirement) <> \" x \" <> requirementCommandName requirement <> \": \" <> kindPhrase <> \" (\" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey (requirementKey requirement)) <> \")\")",-           "        code",-           "        detail",-           "    )",-           " where",-           "  kindPhrase = case requirementKind requirement of",-           "    LiveTransition -> \"live transition\"",-           "    RequiredRejection -> \"required rejection\"",-           "    ReplayTransition -> \"replay-only transition\"",-           "sortedKeys :: [BehaviorKey] -> [BehaviorKey]",-           "sortedKeys = sortOn unBehaviorKey",-           "keyTexts :: [BehaviorKey] -> [Text]",-           "keyTexts = map unBehaviorKey",-           "countLine :: Text -> [BehaviorKey] -> Text",-           "countLine label values = label <> \": \" <> tshow (length values)",-           "tshow :: Show value => value -> Text",-           "tshow = T.pack . show"-         ]-  where-    name = aName aggregate-    valueStem = lowerFirst name-    handlerName = valueStem <> "DomainCommandHandler"-    outcomeResultTypes = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just outcomeTypes -> [resolvedRejectionType outcomeTypes, resolvedNoOpType outcomeTypes]-    outcomeImportPlan = eventStreamImportPlan aggregate outcomeResultTypes []-    outcomeGeneratedNominals = generatedNominalsInTypes outcomeResultTypes-    outcomeBehaviorImports = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just _ ->-        ["import " <> aGenPrefix aggregate <> ".EventStream (" <> handlerName <> ")"]-          <> [ "import "-                 <> generatedNominalModule (aContext aggregate)-                 <> " ("-                 <> T.intercalate ", " (map resolvedNominalName (stableNominals outcomeGeneratedNominals))-                 <> ")"-             | not (null outcomeGeneratedNominals)-             ]-          <> T.lines (renderPlannedImports outcomeImportPlan)-          <> ["import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))"]-    outcomeExpectationConstructors = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just outcomeTypes ->-        [ "  | RejectedWith " <> renderDomainType outcomeImportPlan aggregate (resolvedRejectionType outcomeTypes),-          "  | NoOpWith " <> renderDomainType outcomeImportPlan aggregate (resolvedNoOpType outcomeTypes)-        ]-    outcomeGenericRejectionCases = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just _ ->-        [ "  RejectedWith _ -> failure requirement \"expectation-kind\" \"an unmatched-command rejection cannot expect a selected domain rejection\"",-          "  NoOpWith _ -> failure requirement \"expectation-kind\" \"an unmatched-command rejection cannot expect a selected domain no-op\""-        ]-    genericNoOpAcceptanceLines = case aDomainOutcomeTypes aggregate of-      Just _ -> ["  NoOp -> failure requirement \"expectation-kind\" \"an outcome-enabled transition requires RejectedWith or NoOpWith exact reason evidence\""]-      Nothing ->-        [ "  NoOp -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",-          "    Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",-          "    Right success -> do",-          "      checkAcceptedEnvelope requirement success",-          "      ensure requirement (null (K.stepSuccessOutputs success)) \"noop-emitted\" \"NoOp emitted one or more events\"",-          "      ensure requirement (K.stepSuccessState success == fst seed) \"noop-vertex-change\" \"NoOp changed the control vertex\"",-          "      ensure requirement (regsEqual (K.stepSuccessRegs success) (snd seed)) \"noop-register-change\" \"NoOp changed one or more registers\""-        ]-    outcomeExactAcceptanceCases = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just _ ->-        [ "  RejectedWith expectedReason -> do",-          "    decision <- runSilentDecision requirement seed command",-          "    case decision of",-          "      SilentRejected actualReason -> ensure requirement (actualReason == expectedReason) \"domain-rejection-reason\" (\"selected rejection reason differs; actual=\" <> tshow actualReason <> \" expected=\" <> tshow expectedReason)",-          "      SilentNoOp actualReason -> failure requirement \"domain-outcome-kind\" (\"expected a selected rejection but classifier returned no-op \" <> tshow actualReason)",-          "  NoOpWith expectedReason -> do",-          "    decision <- runSilentDecision requirement seed command",-          "    case decision of",-          "      SilentRejected actualReason -> failure requirement \"domain-outcome-kind\" (\"expected a selected no-op but classifier returned rejection \" <> tshow actualReason)",-          "      SilentNoOp actualReason -> ensure requirement (actualReason == expectedReason) \"domain-noop-reason\" (\"selected no-op reason differs; actual=\" <> tshow actualReason <> \" expected=\" <> tshow expectedReason)"-        ]-    outcomeSilentRunnerLines = case aDomainOutcomeTypes aggregate of-      Nothing -> []-      Just outcomeTypes ->-        [ "",-          "runSilentDecision",-          "  :: BehaviorRequirement",-          "  -> (" <> aVertexType aggregate <> ", K.RegFile " <> name <> "Regs)",-          "  -> " <> name <> "Command",-          "  -> Either BehaviorFailure (SilentDomainDecision " <> renderDomainType outcomeImportPlan aggregate (resolvedRejectionType outcomeTypes) <> " " <> renderDomainType outcomeImportPlan aggregate (resolvedNoOpType outcomeTypes) <> ")",-          "runSilentDecision requirement seed command = case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",-          "  Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",-          "  Right success -> do",-          "    checkAcceptedEnvelope requirement success",-          "    ensure requirement (null (K.stepSuccessOutputs success)) \"silent-emitted\" \"typed silent outcome emitted one or more events\"",-          "    ensure requirement (K.stepSuccessState success == fst seed) \"silent-vertex-change\" \"typed silent outcome changed the control vertex\"",-          "    ensure requirement (regsEqual (K.stepSuccessRegs success) (snd seed)) \"silent-register-change\" \"typed silent outcome changed one or more registers\"",-          "    case " <> handlerName <> " of",-          "      DomainCommandHandler _ classify ->",-          "        Right (classify (SilentCommandContext (fst seed) (snd seed) command (K.stepSuccessEdge success)))"-        ]-    behaviorCoreImports =-      [ "EdgeMode (..)",-        "EdgeRef (..)",-        "RegFile",-        "ReplayAttribution (..)",-        "ReplayEventSpan (..)",-        "ReplaySuccess (..)",-        "StepFailure (..)",-        "StepSuccess (..)",-        "applyEventsDetailedEither",-        "stepDetailedEither"-      ]-        <> ["(!)" | not (null (aRegs aggregate))]--renderCommandKind :: Agg -> [Text]-renderCommandKind aggregate = case aCommands aggregate of-  [] -> ["", "commandKind :: " <> aName aggregate <> "Command -> Text", "commandKind _ = \"\""]-  commands ->-    [ "",-      "commandKind :: " <> aName aggregate <> "Command -> Text",-      "commandKind command = case command of"-    ]-      <> ["  " <> rcName command <> " _ -> " <> tshow (rcName command) | command <- commands]--renderBehaviorRequirementList :: Agg -> [Text]-renderBehaviorRequirementList aggregate =-  case behaviorRequirementsFor aggregate of-    [] -> ["  []"]-    requirements ->-      concat-        [ render index requirement-        | (index, requirement) <- zip [0 ..] requirements-        ]-        <> ["  ]"]-  where-    render index requirement =-      [ (if index == (0 :: Int) then "  [ -- " else "  , -- ") <> behaviorRequirementLabel aggregate requirement,-        "    BehaviorRequirement",-        "      { requirementKey = BehaviorKey " <> tshow (Behavior.unBehaviorKey (Behavior.requirementKey requirement)),-        "      , requirementKind = " <> T.pack (show (Behavior.requirementKind requirement)),-        "      , requirementEvidence = " <> T.pack (show (Behavior.requirementEvidence requirement)),-        "      , requirementGuardCoverage = " <> T.pack (show (Behavior.requirementGuardCoverage requirement)),-        "      , requirementSource = " <> vertexCtor aggregate (Behavior.requirementSource requirement),-        "      , requirementCommandName = " <> tshow (Behavior.requirementCommand requirement),-        "      , requirementExpectedEdge = " <> edgeExpr aggregate requirement,-        "      , requirementTarget = " <> maybe "Nothing" (\target -> "Just " <> vertexCtor aggregate target) (Behavior.requirementTarget requirement),-        "      , requirementEventKinds = " <> renderBehaviorTextList (Behavior.requirementEvents requirement),-        "      }"-      ]--behaviorRequirementLabel :: Agg -> Behavior.BehaviorRequirement -> Text-behaviorRequirementLabel aggregate requirement =-  vertexCtor aggregate (Behavior.requirementSource requirement)-    <> " x "-    <> Behavior.requirementCommand requirement-    <> ": "-    <> ( case Behavior.requirementKind requirement of-           Behavior.LiveTransition -> "live transition"-           Behavior.RequiredRejection -> "required rejection"-           Behavior.ReplayTransition -> "replay-only transition"-       )--edgeExpr :: Agg -> Behavior.BehaviorRequirement -> Text-edgeExpr aggregate requirement = case Behavior.requirementKind requirement of-  Behavior.RequiredRejection -> "Nothing"-  _ -> case behaviorEdgeIndex aggregate requirement of-    Nothing -> error ("required behavior transition missing from resolved aggregate: " <> T.unpack (Behavior.requirementCanonical requirement))-    Just edgeIndex ->-      "(Just (K.EdgeRef "-        <> vertexCtor aggregate (Behavior.requirementSource requirement)-        <> " "-        <> tshow' edgeIndex-        <> "))"--behaviorEdgeIndex :: Agg -> Behavior.BehaviorRequirement -> Maybe Int-behaviorEdgeIndex aggregate requirement = case Behavior.requirementOrigin requirement of-  Behavior.RejectionRequirementOrigin {} -> Nothing-  Behavior.TransitionRequirementOrigin originAggregate (SourceIndex.TransitionOrdinal ordinal) -> do-    transition <- case drop ordinal (aTransitions aggregate) of-      candidate : _ -> Just candidate-      [] -> Nothing-    if originAggregate == aName aggregate-      && tSource transition == Behavior.requirementSource requirement-      && tCommand transition == Behavior.requirementCommand requirement-      then-        Just-          ( length-              [ ()-              | candidate <- take ordinal (aTransitions aggregate),-                tSource candidate == tSource transition-              ]-          )-      else Nothing--behaviorRequirementsFor :: Agg -> [Behavior.BehaviorRequirement]-behaviorRequirementsFor aggregate =-  case Behavior.deriveAggregateBehaviorRequirements (aSpec aggregate) (aAggregate aggregate) of-    Left derivationError -> error ("validated aggregate failed behavior derivation: " <> show derivationError)-    Right requirements -> sortOn Behavior.requirementKey requirements--renderBehaviorTextList :: [Text] -> Text-renderBehaviorTextList values = "[" <> T.intercalate ", " (map tshow values) <> "]"--regsEqualityExpression :: Agg -> Text-regsEqualityExpression aggregate = case aRegs aggregate of-  [] -> "regsEqual _ _ = True"-  registers ->-    "regsEqual left right = "-      <> T.intercalate-        " && "-        [ "(left K.! #" <> rrName register <> ") == (right K.! #" <> rrName register <> ")"-        | register <- registers-        ]--behaviorHoleModule :: Agg -> ScaffoldModule-behaviorHoleModule aggregate =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" (aHolePrefix aggregate) <> "/BehaviorHoles.hs"),-      moduleText = emitBehaviorHoles aggregate,-      kind = HoleStub,-      origin = nodeOrigin "aggregate behavior witnesses" (aName aggregate) (aLoc aggregate)-    }--emitBehaviorHoles :: Agg -> Text-emitBehaviorHoles aggregate =-  nl $-    [ "-- Consumer-owned behavioral witnesses. Created once; never overwritten.",-      "module " <> aHolePrefix aggregate <> ".BehaviorHoles (behaviorWitnesses) where",-      "",-      "import " <> aGenPrefix aggregate <> ".BehaviorContract",-      "",-      "behaviorWitnesses :: [BehaviorWitness]",-      "behaviorWitnesses ="-    ]-      <> case behaviorRequirementsFor aggregate of-        [] -> ["  []"]-        requirements ->-          [ (if index == (0 :: Int) then "  [ " else "  , ")-              <> "Pending (BehaviorKey "-              <> tshow (Behavior.unBehaviorKey (Behavior.requirementKey requirement))-              <> ") -- "-              <> behaviorRequirementLabel aggregate requirement-          | (index, requirement) <- zip [0 ..] requirements-          ]-            <> ["  ]"]---- | Emit the context-wide replay-audit target assembly.------ There is one existential target per aggregate declaration. Process saga--- aggregates are ordinary aggregate nodes referenced by 'SagaRef', so they are--- included by the same single source of truth rather than being duplicated from--- the process declaration.-scaffoldReplayAudit :: Context -> Spec -> [ScaffoldModule]-scaffoldReplayAudit ctx spec-  | null aggregates = []-  | otherwise =-      [ ScaffoldModule-          { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-            moduleText = emitReplayAudit,-            kind = Generated,-            origin = "context " <> specContext spec <> " replay-audit assembly"-          }-      ]-  where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]-    moduleName = contextGeneratedPrefix ctx <> ".ReplayAudit"-    emitReplayAudit =-      nl $-        renderGeneratedLanguagePragmas []-          <> [ generatedBanner,-               "--",-               "-- Deployment contract:",-               "--   * replay-neutral diff: no data audit is required;",-               "--   * affected diff: run AuditTargeted with the emitted affected set",-               "--     against a production copy under the candidate binary;",-               "--   * one-time runtime cutover: run AuditFull;",-               "--   * any non-zero audit exit blocks deployment.",-               "module " <> moduleName <> " (auditTargets) where",-               ""-             ]-          ++ [ "import " <> genPrefixFor ctx (aggName aggregate) <> ".EventStream qualified as " <> aggName aggregate-             | aggregate <- aggregates-             ]-          ++ [ "import Keiro.ReplayAudit (AuditTarget (..), SomeAuditTarget (..), streamInCategory)",-               "import Keiro.Stream qualified as Stream",-               "",-               "auditTargets :: [SomeAuditTarget]",-               "auditTargets ="-             ]-          ++ concat-            [ [ if index == (0 :: Int) then "  [ SomeAuditTarget" else "  , SomeAuditTarget",-                "      AuditTarget",-                "        { eventStream = " <> aggregateName <> "." <> lowerFirst aggregateName <> "EventStream",-                "        , category = Stream.categoryText " <> aggregateName <> "." <> lowerFirst aggregateName <> "Category",-                "        , mkStream = streamInCategory (Stream.categoryText " <> aggregateName <> "." <> lowerFirst aggregateName <> "Category)",-                "        }"-              ]-            | (index, aggregate) <- zip [0 ..] aggregates,-              let aggregateName = aggName aggregate-            ]-          ++ ["  ]"]--genModule :: Agg -> Text -> Text -> ScaffoldModule-genModule a name body =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" (aGenPrefix a) <> "/" <> name <> ".hs"),-      moduleText = body,-      kind = Generated,-      origin = nodeOrigin "aggregate" (aName a) (aLoc a)-    }--holeModule :: Agg -> Text -> ScaffoldModule-holeModule a body =-  ScaffoldModule-    { modulePath = T.unpack (T.replace "." "/" (aHolePrefix a) <> "/" <> "Holes.hs"),-      moduleText = body,-      kind = HoleStub,-      origin = nodeOrigin "aggregate" (aName a) (aLoc a)-    }------------------------------------------------------------------------------------- Integration contract (EP-4): a self-contained payload ADT + codec------------------------------------------------------------------------------------- | Emit the deterministic, symbol-free contract layer: a payload ADT--- (per-event records), the topic constants, the @messageType@ discriminator, and a--- strict encode\/decode keyed by it. Self-contained (base\/text\/aeson), so it--- compiles standalone — the cross-service schema both producer and consumer agree--- on. No keiki symbolic operator (firewall holds).-scaffoldContract :: Context -> ContractNode -> [ScaffoldModule]-scaffoldContract ctx = scaffoldContractWithLanguage ctx (effectiveLanguageContract LegacyUnversioned)---- | Emit a contract under the checked service's released semantic contract.--- Language versions 1 through 3 retain the legacy Text representation; only--- runtime semantics 3 lowers declared TypeID fields to prefix-indexed KindIDs.-scaffoldContractForService :: Context -> CheckedService -> ContractNode -> [ScaffoldModule]-scaffoldContractForService ctx service = scaffoldContractWithLanguage ctx (checkedLanguageContract service)--scaffoldContractWithLanguage :: Context -> EffectiveLanguageContract -> ContractNode -> [ScaffoldModule]-scaffoldContractWithLanguage ctx languageContract c =-  [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/Contract.hs"),-        moduleText = emitContractGen languageContract genPrefix c,-        kind = Generated,-        origin = nodeOrigin "contract" (ctrName c) (ctrLoc c)-      }-  ]-  where-    genPrefix = genPrefixFor ctx (pascal (ctrName c))--emitContractGen :: EffectiveLanguageContract -> Text -> ContractNode -> Text-emitContractGen languageContract genPrefix c =-  ( nl $-      pragmas-        ++ [generatedBanner]-        ++ moduleHeader-        ++ [ "",-             -- A typed-TypeID field decodes through explicitParseField, so a-             -- contract whose every field is one never uses (.:) and would warn-             -- under -Wunused-imports.-             "import Data.Aeson ("-               <> T.intercalate ", " (["Value", "object", "withObject", "withText"] <> ["(.:)" | usesPlainFieldDecode] <> ["(.=)"])-               <> ")",-             aesonTypesImport-           ]-        ++ typedKindIdImports-        ++ [ "import Data.Text (Text)",-             "import qualified Data.Text as T"-           ]-        ++ ["import Keiro.Codec.IdDomain (parseKindIdV7Value)" | hasTypedTypeIds]-        ++ [ "",-             "-- topic constants"-           ]-        ++ topicConstants-        ++ [ "",-             "-- the closed payload set (discriminated by " <> tshow (ctrDiscriminator c) <> ")"-           ]-        ++ [emitPayloadAdt languageContract payloadTy (ctrEvents c)]-        ++ [ "",-             "messageTypeOf :: " <> payloadTy <> " -> Text",-             "messageTypeOf = \\case"-           ]-        ++ ["  " <> ceName e <> " {} -> " <> tshow (ceName e) | e <- ctrEvents c]-        ++ [ "",-             "encode" <> payloadTy <> " :: " <> payloadTy <> " -> Value",-             "encode" <> payloadTy <> " = \\case"-           ]-        ++ concatMap encodeArm (ctrEvents c)-        ++ [ "",-             "parse" <> payloadTy <> " :: Value -> Either Text " <> payloadTy,-             "parse" <> payloadTy <> " = mapLeftText . parseEither (withObject " <> tshow payloadTy <> " go)",-             "  where",-             "    go o = do",-             "      kind <- explicitParseField (withText " <> tshow (ctrDiscriminator c) <> " validateMessageType) o " <> tshow (ctrDiscriminator c),-             "      case kind of"-           ]-        ++ concatMap decodeArm (ctrEvents c)-        ++ [ "        _ -> fail \"validated message type was not handled\"",-             "",-             "mapLeftText :: Either String b -> Either Text b",-             "mapLeftText = either (Left . T.pack) Right",-             "",-             "validateMessageType :: Text -> Parser Text",-             "validateMessageType kind",-             "  | kind `elem` " <> renderTextList (map ceName (ctrEvents c)) <> " = pure kind",-             "  | otherwise = " <> renderUnknownFailure "message type" "kind" (map ceName (ctrEvents c))-           ]-  )-    <> if hasTypedTypeIds then "\n" else ""-  where-    payloadTy = pascal (ctrName c) <> "Payload"-    hasTypedTypeIds = any (any (isTypedTypeId . cfType) . ceFields) (ctrEvents c)-    usesPlainFieldDecode = any (any (not . isTypedTypeId . cfType) . ceFields) (ctrEvents c)-    pragmas =-      renderGeneratedLanguagePragmas-        ( [ExtDuplicateRecordFields | contractNeedsDuplicateRecordFields c]-            <> [ExtOverloadedRecordDot | contractUsesRecordDot c]-        )-    typedKindIdImports-      | hasTypedTypeIds = ["import Data.KindID (KindID)", "import qualified Data.KindID as KindID"]-      | otherwise = []-    moduleHeader =-      [ "module " <> genPrefix <> ".Contract",-        "  ( " <> payloadTy <> " (..)"-      ]-        ++ ["  , " <> ceName event <> "Data (..)" | event <- ctrEvents c]-        ++ ["  , " <> lowerFirst alias <> "Topic" | (alias, _) <- ctrTopics c]-        ++ [ "  , messageTypeOf",-             "  , encode" <> payloadTy,-             "  , parse" <> payloadTy,-             "  ) where"-           ]-    topicConstants-      | hasTypedTypeIds =-          [ T.intercalate-              "\n\n"-              [lowerFirst alias <> "Topic :: Text\n" <> lowerFirst alias <> "Topic = " <> tshow topic | (alias, topic) <- ctrTopics c]-          ]-      | otherwise = [lowerFirst alias <> "Topic :: Text\n" <> lowerFirst alias <> "Topic = " <> tshow topic | (alias, topic) <- ctrTopics c]-    isTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)-    isTypedTypeId _ = False-    aesonTypesImport = "import Data.Aeson.Types (Parser, explicitParseField, parseEither)"-    encodeArm e =-      [ "  " <> ceName e <> " payload ->",-        "    object"-      ]-        ++ objectEntriesFor ((tshow (ctrDiscriminator c) <> " .= (" <> tshow (ceName e) <> " :: Text)") : map encodeField (ceFields e))-        ++ ["      ]"]-    lead 0 kv = "      [ " <> kv-    lead _ kv = "      , " <> kv-    objectEntriesFor entries-      | hasTypedTypeIds =-          [ (if index == 0 then "      [ " else "        ")-              <> entry-              <> if index < length entries - 1 then "," else ""-          | (index, entry) <- zip [(0 :: Int) ..] entries-          ]-      | otherwise = [lead index entry | (index, entry) <- zip [(0 :: Int) ..] entries]-    decodeArm e =-      ["        " <> tshow (ceName e) <> " ->"]-        ++ case ceFields e of-          [] -> ["          pure (" <> ceName e <> " " <> ceName e <> "Data)"]-          fields ->-            [ "          " <> ceName e,-              "            <$> ( " <> ceName e <> "Data"-            ]-              ++ [ (if index == 0 then "                    <$> " else "                    <*> ") <> decodeField field-                 | (index, field) <- zip [(0 :: Int) ..] fields-                 ]-              ++ ["                )"]-    encodeField field =-      tshow (fieldWireKey identity)-        <> " .= "-        <> case cfType field of-          CTypeId prefix-            | isJust (contractIdDomainContractFor languageContract prefix) -> "KindID.toText payload." <> fieldSelector identity-          _ -> "payload." <> fieldSelector identity-      where-        identity = resolveContractFieldIdentity field-    decodeField field = case cfType field of-      CTypeId prefix-        | isJust (contractIdDomainContractFor languageContract prefix) ->-            "explicitParseField (parseKindIdV7Value @" <> tshow prefix <> ") o " <> tshow wireKey-      _ -> "o .: " <> tshow wireKey-      where-        wireKey = fieldWireKey (resolveContractFieldIdentity field)--contractNeedsDuplicateRecordFields :: ContractNode -> Bool-contractNeedsDuplicateRecordFields = hasDuplicateNames . concatMap (map (fieldSelector . resolveContractFieldIdentity) . ceFields) . ctrEvents--contractUsesRecordDot :: ContractNode -> Bool-contractUsesRecordDot = any (not . null . ceFields) . ctrEvents--emitPayloadAdt :: EffectiveLanguageContract -> Text -> [ContractEvent] -> Text-emitPayloadAdt languageContract tyName events =-  sectionsOf [map dataRecord events, [sumDecl]]-  where-    hasTypedTypeIds = any (any (isTypedTypeId . cfType) . ceFields) events-    isTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)-    isTypedTypeId _ = False-    hsType CText = "Text"-    hsType CInt = "Int"-    hsType (CTypeId prefix)-      | isJust (contractIdDomainContractFor languageContract prefix) = "(KindID " <> tshow prefix <> ")"-      | otherwise = "Text"-    dataRecord e =-      "data "-        <> ceName e-        <> "Data = "-        <> ceName e-        <> (if hasTypedTypeIds then "Data {" else "Data { ")-        <> T.intercalate ", " [fieldSelector (resolveContractFieldIdentity f) <> " :: !" <> hsType (cfType f) | f <- ceFields e]-        <> (if hasTypedTypeIds then "}\n  deriving stock (Eq, Show)" else " }\n  deriving stock (Eq, Show)")-    arm e = ceName e <> " !" <> ceName e <> "Data"-    sumDecl = case events of-      [] -> "data " <> tyName <> " = " <> tyName <> "Empty\n  deriving stock (Eq, Show)"-      (e : es) ->-        nl-          ( (if hasTypedTypeIds then ["data " <> tyName, "  = " <> arm e] else ["data " <> tyName <> " = " <> arm e])-              ++ ["  | " <> arm e2 | e2 <- es]-              ++ ["  deriving stock (Eq, Show)"]-          )------------------------------------------------------------------------------------- Integration intake (EP-4): inbox disposition vs the live Keiro.Inbox runtime------------------------------------------------------------------------------------- | Emit the inbox node's deterministic disposition wiring compiled against the--- LIVE @Keiro.Inbox.Types@: the dedupe policy (a real 'InboxDedupePolicy') and a--- disposition function over the real @InboxResult@ (including handler--- failures). This pins the dangerous inversions--- (duplicate ⇒ ackOk, previouslyFailed ⇒ deadLetter) as compiled code over the--- runtime types. The complete declared classification table is also available--- to handler holes through a closed generated outcome type. Firewall holds (no--- keiki symbolic operator).-scaffoldIntake :: Context -> IntakeNode -> [ScaffoldModule]-scaffoldIntake ctx i =-  [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/Inbox.hs"),-        moduleText = emitIntakeGen genPrefix i,-        kind = Generated,-        origin = nodeOrigin "intake" (inkName i) (inkLoc i)-      }-  ]-  where-    genPrefix = genPrefixFor ctx (pascal (inkName i))--emitIntakeGen :: Text -> IntakeNode -> Text-emitIntakeGen genPrefix i =-  nl $-    renderGeneratedLanguagePragmas []-      <> [ generatedBanner,-           "module " <> genPrefix <> ".Inbox",-           "  ( InboxFailure (..)",-           "  , " <> outcomeType <> " (..)",-           "  , " <> dispositionType <> " (..)",-           "  , inboxDedupePolicy",-           "  , inboxPersistence",-           "  , inboxDispositionFor",-           "  , inboxDisposition",-           "  ) where",-           "",-           "import Data.Text (Text)",-           "import Keiro.Inbox.Types (InboxDedupePolicy (..), InboxPersistence (..), InboxResult (..), RetryDelay (..))",-           "",-           "-- The dedupe policy (hole-kind 4), lowered to the live InboxDedupePolicy.",-           "inboxDedupePolicy :: InboxDedupePolicy",-           "inboxDedupePolicy = " <> inkDedupePolicy i,-           "",-           "-- | Success-path envelope retention passed to runInboxTransactionWith.",-           "-- Failures always retain their full operator-facing dead-letter envelope.",-           "-- Dedupe-only success rows decode with an empty payload.",-           "inboxPersistence :: InboxPersistence",-           "inboxPersistence = " <> persistenceCtor (inkPersist i),-           "",-           "-- Runtime failure detail retained when the inbox wrapper reports a failed handler attempt.",-           "data InboxFailure = InboxFailure",-           "  { inboxFailureReason :: !Text",-           "  , inboxFailureAttempt :: !(Maybe Int)",-           "  }",-           "  deriving stock (Eq, Show)",-           "",-           "-- Every classification named by the spec. Keeping this closed makes the",-           "-- generated table exhaustive and gives handler holes typed inputs.",-           "data " <> outcomeType,-           "  = " <> T.intercalate "\n  | " outcomeConstructors,-           "  deriving stock (Eq, Show)",-           "",-           "-- The service's declared acknowledgement decision, including its details.",-           "data " <> dispositionType,-           "  = InboxAccept",-           "  | InboxRetryAfter !RetryDelay !(Maybe InboxFailure)",-           "  | InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)",-           "  deriving stock (Eq, Show)",-           "",-           "-- The complete disposition table (hole-kind 2).",-           "inboxDispositionFor :: " <> outcomeType <> " -> " <> dispositionType,-           "inboxDispositionFor outcome = case outcome of"-         ]-      ++ ["  " <> outcomeConstructor (drOutcome row) <> " -> " <> actionExpression (drAction row) | row <- inkDisposition i]-      ++ [ "",-           "-- Lower the LIVE Keiro.Inbox.Types.InboxResult without an open fallback.",-           "inboxDisposition :: InboxResult a -> " <> dispositionType,-           "inboxDisposition r = case r of",-           "  InboxProcessed _ -> inboxDispositionFor " <> outcomeConstructor "processed",-           "  InboxDuplicate -> inboxDispositionFor " <> outcomeConstructor "duplicate",-           "  InboxInProgress -> inboxDispositionFor " <> outcomeConstructor "inProgress",-           "  InboxPreviouslyFailed failureReason ->",-           "    maybe (inboxDispositionFor " <> outcomeConstructor "previouslyFailed" <> ")",-           "      (\\reason -> attachFailure (InboxFailure reason Nothing) (inboxDispositionFor " <> outcomeConstructor "previouslyFailed" <> "))",-           "      failureReason",-           "  InboxHandlerFailed reason attempts ->",-           "    attachFailure (InboxFailure reason (Just attempts)) (inboxDispositionFor " <> outcomeConstructor "storeFailed" <> ")",-           "",-           "attachFailure :: InboxFailure -> " <> dispositionType <> " -> " <> dispositionType,-           "attachFailure failure disposition = case disposition of",-           "  InboxRetryAfter delay _ -> InboxRetryAfter delay (Just failure)",-           "  InboxDeadLetter reason _ -> InboxDeadLetter reason (Just failure)",-           "  InboxAccept -> InboxAccept"-         ]-  where-    stem = pascal (inkName i)-    outcomeType = stem <> "Outcome"-    dispositionType = stem <> "Disposition"-    outcomeConstructor = (stem <>) . pascal-    outcomeConstructors = map (outcomeConstructor . drOutcome) (inkDisposition i)-    actionExpression IAckOk = "InboxAccept"-    actionExpression (IRetry win) = "InboxRetryAfter (RetryDelay " <> windowText win <> ") Nothing"-    actionExpression (IDeadLetter mr) = "InboxDeadLetter " <> maybe "Nothing" (\reason -> "(Just " <> tshow reason <> ")") mr <> " Nothing"-    persistenceCtor InkPersistFull = "PersistFullEnvelope"-    persistenceCtor InkPersistDedupeOnly = "PersistDedupeOnly"------------------------------------------------------------------------------------- Integration publisher (EP-4): config vs the live Keiro.Outbox runtime------------------------------------------------------------------------------------- | Emit the publisher's at-least-once policy compiled against the LIVE--- @Keiro.Outbox.Types@: the ordering policy (a real 'OrderingPolicy'), the backoff--- curve (a real 'BackoffSchedule'), and the max-attempts ceiling. Firewall holds.-scaffoldPublisher :: Context -> PublisherNode -> [ScaffoldModule]-scaffoldPublisher ctx pb =-  [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/Publisher.hs"),-        moduleText = emitPublisherGen genPrefix pb,-        kind = Generated,-        origin = nodeOrigin "publisher" (pubName pb) (pubLoc pb)-      }-  ]-  where-    genPrefix = genPrefixFor ctx (pascal (pubName pb))--emitPublisherGen :: Text -> PublisherNode -> Text-emitPublisherGen genPrefix pb =-  nl-    [ generatedBanner,-      "module " <> genPrefix <> ".Publisher",-      "  ( publisherOrdering",-      "  , publisherBackoff",-      "  , publisherMaxAttempts",-      "  ) where",-      "",-      -- Only an exponential schedule mentions ExponentialBackoffOptions, and an-      -- unconditional import makes a constant-backoff publisher warn under-      -- -Wunused-imports. Generated code compiles under -Werror.-      "import Keiro.Outbox.Types (BackoffSchedule (..), OrderingPolicy (..)"-        <> (if boKind (pubBackoff pb) == "exponential" then ", ExponentialBackoffOptions (..)" else "")-        <> ")",-      "",-      "publisherOrdering :: OrderingPolicy",-      "publisherOrdering = " <> pubOrdering pb,-      "",-      "publisherBackoff :: BackoffSchedule",-      "publisherBackoff = " <> backoffExpr (pubBackoff pb),-      "",-      "publisherMaxAttempts :: Int",-      "publisherMaxAttempts = " <> tshow' (pubMaxAttempts pb)-    ]-  where-    backoffExpr b = case boKind b of-      "constant" -> "ConstantBackoff " <> windowText (boWindow b)-      "exponential" ->-        "ExponentialBackoff ExponentialBackoffOptions { initial = "-          <> windowText (boWindow b)-          <> ", maxDelay = "-          <> maybe "0" windowText (boMax b)-          <> ", multiplier = "-          <> fromMaybe "0" (boMultiplier b)-          <> " }"-      _ -> "error \"keiro-dsl: unlowerable backoff kind\""------------------------------------------------------------------------------------- pgmq workqueue (EP-5): a self-contained Job payload record + codec------------------------------------------------------------------------------------- | Emit the deterministic, symbol-free pgmq layer: the Job payload record, the--- field→wire-name JSON codec, and the captured physical\/dlq\/table name constants.--- Self-contained (base\/text\/aeson). The fan-out body and the raw-SQL dedup--- predicate are holes (not emitted). Firewall holds.-scaffoldWorkqueue :: Context -> WorkqueueNode -> [ScaffoldModule]-scaffoldWorkqueue ctx w =-  scaffoldWorkqueueWithQueueText ctx w (emitWorkqueueGen genPrefix w)-  where-    genPrefix = genPrefixFor ctx (pascal (wqName w))---- | Service-aware workqueue generation resolves candidate type expressions--- against the checked graph. Legacy scalar workqueues deliberately stay on--- 'emitWorkqueueGen' so their generated bytes cannot drift.-scaffoldWorkqueueForService :: Context -> CheckedService -> WorkqueueNode -> [ScaffoldModule]-scaffoldWorkqueueForService ctx service workqueue =-  scaffoldWorkqueueWithQueueText ctx workqueue queueText-  where-    genPrefix = genPrefixFor ctx (pascal (wqName workqueue))-    queueText-      | any isTypedQueueField (wqPayload workqueue) =-          case checkedTypeGraph service of-            Left errors -> error ("checked workqueue type graph failed: " <> show errors)-            Right graph -> emitMappedWorkqueueGen ctx genPrefix graph workqueue-      | otherwise = emitWorkqueueGen genPrefix workqueue--scaffoldWorkqueueWithQueueText :: Context -> WorkqueueNode -> Text -> [ScaffoldModule]-scaffoldWorkqueueWithQueueText ctx w queueText =-  [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/Queue.hs"),-        moduleText = queueText,-        kind = Generated,-        origin = nodeOrigin "workqueue" (wqName w) (wqLoc w)-      },-    ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/QueuePolicy.hs"),-        moduleText = emitQueuePolicy genPrefix w,-        kind = Generated,-        origin = nodeOrigin "workqueue" (wqName w) (wqLoc w)-      },-    ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/QueueCodec.hs"),-        moduleText = emitQueueCodec genPrefix w,-        kind = Generated,-        origin = nodeOrigin "workqueue" (wqName w) (wqLoc w)-      }-  ]-  where-    genPrefix = genPrefixFor ctx (pascal (wqName w))--isTypedQueueField :: WqField -> Bool-isTypedQueueField field = case wqfType field of-  LegacyQueueScalar {} -> False-  TypedQueueExpression {} -> True--emitWorkqueueGen :: Text -> WorkqueueNode -> Text-emitWorkqueueGen genPrefix w =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | workqueueUsesRecordDot w]-      <> [ generatedBanner,-           "module " <> genPrefix <> ".Queue",-           "  ( " <> payloadTy <> " (..)",-           "  , encode" <> payloadTy,-           "  , parse" <> payloadTy,-           "  , queuePhysical, queueDlq, queueTable",-           groupKeyExport,-           "  ) where",-           "",-           "import Data.Aeson (Value, object, withObject, (.:), (.=))",-           "import Data.Aeson.Types (parseEither)",-           "import Data.Text (Text)",-           "import qualified Data.Text as T",-           "",-           "queuePhysical, queueDlq, queueTable :: Text",-           "queuePhysical = " <> tshow (wqPhysical w),-           "queueDlq = " <> tshow (wqDlq w),-           "queueTable = " <> tshow (wqTable w),-           ""-         ]-      ++ groupKeyLines-      ++ [ "data " <> payloadTy <> " = " <> payloadTy,-           "  { " <> T.intercalate "\n  , " [wqfName f <> " :: !" <> payloadFieldType f | f <- wqPayload w],-           "  }",-           "  deriving stock (Eq, Show)",-           "",-           "encode" <> payloadTy <> " :: " <> payloadTy <> " -> Value",-           "encode" <> payloadTy <> " p =",-           "  object"-         ]-      ++ [lead i (tshow (wqfWire f) <> " .= p." <> wqfName f) | (i, f) <- zip [(0 :: Int) ..] (wqPayload w)]-      ++ [ "    ]",-           "",-           "parse" <> payloadTy <> " :: Value -> Either Text " <> payloadTy,-           "parse" <> payloadTy <> " = mapLeftText . parseEither (withObject " <> tshow payloadTy <> " go)",-           "  where",-           "    go o = " <> payloadTy <> fieldApps (wqPayload w),-           "",-           "mapLeftText :: Either String b -> Either Text b",-           "mapLeftText = either (Left . T.pack) Right"-         ]-  where-    payloadTy = wqPayloadName w-    payloadFieldType field = case wqfType field of-      LegacyQueueScalar scalar -> hsType (queueScalarName scalar)-      TypedQueueExpression _ -> error "keiro-dsl internal invariant: mapped queue lowering is pending"-    groupKeyExport = case wqGroupKey w of-      Nothing -> ""-      Just groupKey-        | gkVia groupKey == "raw" -> "  , groupKeyField, groupKeyFor"-        | otherwise -> "  , groupKeyField"-    groupKeyLines = case wqGroupKey w of-      Nothing -> []-      Just groupKey -> common <> derivationLines groupKey-        where-          common =-            [ "groupKeyField :: Text",-              "groupKeyField = " <> tshow (gkField groupKey),-              ""-            ]-          derivationLines key-            | gkVia key == "raw" =-                [ "groupKeyFor :: " <> payloadTy <> " -> Text",-                  "groupKeyFor payload = payload." <> gkField key,-                  ""-                ]-            | otherwise =-                [ "-- Opaque group-key derivation '" <> gkVia key <> "' remains hand-owned.",-                  "-- Captured fixture: " <> fromMaybe "<missing>" (gkFixture key),-                  ""-                ]-    hsType "bool" = "Bool"-    hsType "int" = "Int"-    hsType _ = "Text"-    lead 0 kv = "    [ " <> kv-    lead _ kv = "    , " <> kv-    fieldApps [] = ""-    fieldApps fs = " <$> " <> T.intercalate " <*> " ["o .: " <> tshow (wqfWire f) | f <- fs]--data ResolvedQueueField = ResolvedQueueField-  { resolvedQueueField :: !WqField,-    resolvedQueueExpression :: !(Maybe ResolvedTypeExpr),-    resolvedQueueCodecPlan :: !(Maybe MappedCodecPlan)-  }--emitMappedWorkqueueGen :: Context -> Text -> TypeGraph -> WorkqueueNode -> Text-emitMappedWorkqueueGen ctx genPrefix graph workqueue =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | workqueueUsesRecordDot workqueue]-      <> [ generatedBanner,-           "module " <> genPrefix <> ".Queue",-           "  ( " <> payloadType <> " (..)",-           "  , encode" <> payloadType,-           "  , parse" <> payloadType-         ]-      <> concatMap mappedCodecExports structuralDeclarations-      <> [ "  , queuePhysical, queueDlq, queueTable",-           groupKeyExport,-           "  ) where",-           ""-         ]-      <> mappedQueueImports-      <> [ "",-           "queuePhysical, queueDlq, queueTable :: Text",-           "queuePhysical = " <> tshow (wqPhysical workqueue),-           "queueDlq = " <> tshow (wqDlq workqueue),-           "queueTable = " <> tshow (wqTable workqueue),-           ""-         ]-      <> groupKeyLines-      <> [ "data " <> payloadType <> " = " <> payloadType,-           "  { " <> T.intercalate "\n  , " [wqfName raw <> " :: " <> strictQueueFieldType (queueFieldType field) | field@ResolvedQueueField {resolvedQueueField = raw} <- fields],-           "  }",-           "  deriving stock (Eq, Show)",-           ""-         ]-      <> (if hasStructural then [T.intercalate "\n\n" [emitStructuralCodec importPlan ctx graph declaration shape | ResolvedStructural declaration shape <- declarations], ""] else [])-      <> [ "encode" <> payloadType <> " :: " <> payloadType <> " -> Value",-           "encode" <> payloadType <> " payload =",-           "  object"-         ]-      <> [queueLead index (tshow (wqfWire raw) <> " .= " <> encodeQueueField field) | (index, field@ResolvedQueueField {resolvedQueueField = raw}) <- zip [(0 :: Int) ..] fields]-      <> [ "    ]",-           "",-           "parse" <> payloadType <> " :: Value -> Either Text " <> payloadType,-           "parse" <> payloadType <> " = mapLeftText . parseEither (withObject " <> tshow payloadType <> " go)",-           "  where",-           "    go objectValue = " <> payloadType <> queueFieldApplications fields,-           "",-           "mapLeftText :: Either String b -> Either Text b",-           "mapLeftText = either (Left . T.pack) Right"-         ]-      <> optionalFieldHelper-      <> unknownFieldHelper-  where-    payloadType = wqPayloadName workqueue-    fields = map resolveField (wqPayload workqueue)-    resolveField raw = case wqfType raw of-      LegacyQueueScalar {} -> ResolvedQueueField raw Nothing Nothing-      TypedQueueExpression expression ->-        case resolveTypeExpression graph owner (wqfLoc raw) expression of-          Left failure -> error ("checked queue expression failed: " <> show failure)-          Right resolved ->-            ResolvedQueueField raw (Just resolved) (Just (mappedCodecPlanOrDie graph resolved))-      where-        owner = "workqueue '" <> wqName workqueue <> "' payload field '" <> wqfName raw <> "'"-    plans = [plan | ResolvedQueueField {resolvedQueueCodecPlan = Just plan} <- fields]-    rootExpressions = [expression | ResolvedQueueField {resolvedQueueExpression = Just expression} <- fields]-    selectedKeys = Set.unions (map (dependencies . consumerType) plans)-    declarations = mapMaybe (`Map.lookup` tgDeclarations graph) (Set.toAscList selectedKeys)-    structuralDeclarations = [(declaration, shape) | ResolvedStructural declaration shape <- declarations]-    mappedCodecExports (declaration, _) =-      [ "  , encode" <> sdName declaration <> "Mapped",-        "  , decode" <> sdName declaration <> "Mapped"-      ]-    hasStructural = not (null structuralDeclarations)-    allExpressions = rootExpressions <> concatMap (shapeTypeExpressions . snd) structuralDeclarations-    importsPlanReferences =-      Set.unions (map (consumerTypeReferences . consumerType) plans)-        <> Set.fromList-          [ reference-          | (declaration, shape) <- structuralDeclarations,-            reference <--              haskellTypeReference (sdHaskell declaration)-                : qualifiedValueReference (sdBinding declaration)-                : structuralShapeReferences ctx declaration shape-          ]-    importPlan =-      planImportsOrDie-        (genPrefix <> ".Queue")-        (Set.singleton payloadType)-        importsPlanReferences-    plannedModules = Set.map referenceModule importsPlanReferences-    opaqueInstanceImports =-      sort . nub $-        [ hsModule (odHaskell declaration) <> " ()"-        | ResolvedOpaque declaration <- declarations,-          Set.notMember (hsModule (odHaskell declaration)) plannedModules-        ]-    usesMap = any typeUsesMap allExpressions-    usesOptionalValue = any typeUsesOptional allExpressions-    usesNatural = any typeUsesNatural rootExpressions-    usesTime = any typeUsesTime rootExpressions-    usesParseJson = any (typeUsesParseJson graph) allExpressions-    usesToJson = any (typeUsesToJson graph) allExpressions-    usesValueConstructors = usesOptionalValue || any isEnumShape (map snd structuralDeclarations)-    usesWithText = any isTextShape (map snd structuralDeclarations)-    usesUnknownRejection = any rejectsUnknown (map snd structuralDeclarations)-    usesOptionalField = any hasOptionalField (map snd structuralDeclarations)-    usesKeyMap = usesUnknownRejection || usesOptionalField-    usesParser = hasStructural || any typeUsesParserAnnotation allExpressions-    usesLegacyDecoder = any isLegacy fields-    mappedQueueImports =-      ["import Control.Monad (unless)" | usesUnknownRejection]-        <> ["import Data.Aeson (" <> T.intercalate ", " aesonImports <> ")"]-        <> ["import Data.Aeson.Key qualified as Key" | usesKeyMap]-        <> ["import Data.Aeson.KeyMap qualified as KeyMap" | usesKeyMap]-        <> ["import Data.Aeson.Types (" <> T.intercalate ", " aesonTypesImports <> ")"]-        <> (if usesMap then ["import Data.Map.Strict (Map)", "import Data.Map.Strict qualified as Map"] else [])-        <> ["import Numeric.Natural (Natural)" | usesNatural]-        <> ["import Data.Time (UTCTime)" | usesTime]-        <> [ "import Data.Text (Text)",-             "import qualified Data.Text as T"-           ]-        <> ["import Keiro.Codec.Structural (bindingFromShape, bindingToShape)" | hasStructural]-        <> map ("import " <>) opaqueInstanceImports-        <> T.lines (renderPlannedImports importPlan)-    aesonImports =-      [if usesValueConstructors then "Value (..)" else "Value", "object"]-        <> ["parseJSON" | usesParseJson]-        <> ["toJSON" | usesToJson]-        <> ["withObject"]-        <> ["withText" | usesWithText]-        <> ["(.:)" | usesLegacyDecoder]-        <> ["(.=)"]-    aesonTypesImports =-      ["Parser" | usesParser]-        <> ["explicitParseField", "parseEither"]-    queueFieldType ResolvedQueueField {resolvedQueueField = raw, resolvedQueueExpression = Nothing} = legacyQueueType raw-    queueFieldType ResolvedQueueField {resolvedQueueExpression = Just expression} =-      unHaskellTypeOccurrence $-        either-          (error . ("validated queue consumer type rendering failed: " <>) . show)-          id-          (renderConsumerType importPlan graph expression)-    strictQueueFieldType rendered-      | T.any (== ' ') rendered && not ("[" `T.isPrefixOf` rendered) = "!(" <> rendered <> ")"-      | otherwise = "!" <> rendered-    legacyQueueType raw = case wqfType raw of-      LegacyQueueScalar scalar -> case queueScalarName scalar of-        "bool" -> "Bool"-        "int" -> "Int"-        _ -> "Text"-      TypedQueueExpression {} -> error "typed queue field reached legacy type rendering"-    encodeQueueField ResolvedQueueField {resolvedQueueField = raw, resolvedQueueCodecPlan = Nothing} = "payload." <> wqfName raw-    encodeQueueField ResolvedQueueField {resolvedQueueField = raw, resolvedQueueCodecPlan = Just plan} =-      renderMappedEncode graph ConsumerValueBoundary plan ("payload." <> wqfName raw)-    decodeQueueField ResolvedQueueField {resolvedQueueField = raw, resolvedQueueCodecPlan = Nothing} =-      "objectValue .: " <> tshow (wqfWire raw)-    decodeQueueField ResolvedQueueField {resolvedQueueField = raw, resolvedQueueCodecPlan = Just plan} =-      "explicitParseField ("-        <> renderMappedParse graph ConsumerValueBoundary plan-        <> ") objectValue "-        <> tshow (wqfWire raw)-    queueFieldApplications [] = ""-    queueFieldApplications values = " <$> " <> T.intercalate " <*> " (map decodeQueueField values)-    groupKeyExport = case wqGroupKey workqueue of-      Nothing -> ""-      Just groupKey-        | gkVia groupKey == "raw" -> "  , groupKeyField, groupKeyFor"-        | otherwise -> "  , groupKeyField"-    groupKeyLines = case wqGroupKey workqueue of-      Nothing -> []-      Just groupKey ->-        [ "groupKeyField :: Text",-          "groupKeyField = " <> tshow (gkField groupKey),-          ""-        ]-          <> if gkVia groupKey == "raw"-            then-              [ "groupKeyFor :: " <> payloadType <> " -> Text",-                "groupKeyFor payload = payload." <> gkField groupKey,-                ""-              ]-            else-              [ "-- Opaque group-key derivation '" <> gkVia groupKey <> "' remains hand-owned.",-                "-- Captured fixture: " <> fromMaybe "<missing>" (gkFixture groupKey),-                ""-              ]-    optionalFieldHelper =-      if usesOptionalField-        then-          [ "",-            "parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue",-            "parseOptionalField onMissing parseItem objectValue key =",-            "  case KeyMap.lookup key objectValue of",-            "    Nothing -> onMissing",-            "    Just _ -> explicitParseField parseItem objectValue key"-          ]-        else []-    unknownFieldHelper =-      if usesUnknownRejection-        then-          [ "",-            "rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()",-            "rejectUnknownFields label allowed objectValue =",-            "  unless (null extras) (fail (label <> \" contains unknown fields: \" <> show extras))",-            "  where",-            "    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))"-          ]-        else []-    isLegacy ResolvedQueueField {resolvedQueueCodecPlan = Nothing} = True-    isLegacy ResolvedQueueField {resolvedQueueCodecPlan = Just _} = False-    isEnumShape REnum {} = True-    isEnumShape _ = False-    isTextShape REnum {} = True-    isTextShape RUnion {} = True-    isTextShape _ = False-    rejectsUnknown (RRecord _ RejectUnknown _) = True-    rejectsUnknown (RUnion encoding _) = ueUnknownFields encoding == RejectUnknown-    rejectsUnknown _ = False-    hasOptionalField (RRecord _ _ shapeFields) = any ((== POptional) . rwfPresence) shapeFields-    hasOptionalField _ = False--queueLead :: Int -> Text -> Text-queueLead 0 keyValue = "    [ " <> keyValue-queueLead _ keyValue = "    , " <> keyValue--typeUsesNatural :: ResolvedTypeExpr -> Bool-typeUsesNatural = foldTypeExpr (falseAlgebra {onNatural = True})-  where-    falseAlgebra = TypeExprAlgebra False False False False False False False id id id (const False)--typeUsesTime :: ResolvedTypeExpr -> Bool-typeUsesTime = foldTypeExpr (falseAlgebra {onTime = True})-  where-    falseAlgebra = TypeExprAlgebra False False False False False False False id id id (const False)--typeUsesText :: ResolvedTypeExpr -> Bool-typeUsesText = foldTypeExpr (falseAlgebra {onText = True, onMap = const True})-  where-    falseAlgebra = TypeExprAlgebra False False False False False False False id id id (const False)--typeUsesJson :: ResolvedTypeExpr -> Bool-typeUsesJson = foldTypeExpr (falseAlgebra {onJson = True})-  where-    falseAlgebra = TypeExprAlgebra False False False False False False False id id id (const False)--typeUsesParserAnnotation :: ResolvedTypeExpr -> Bool-typeUsesParserAnnotation = foldTypeExpr (falseAlgebra {onList = const True, onMap = const True})-  where-    falseAlgebra = TypeExprAlgebra False False False False False False False id id id (const False)--typeUsesParseJson :: TypeGraph -> ResolvedTypeExpr -> Bool-typeUsesParseJson graph =-  foldTypeExpr-    TypeExprAlgebra-      { onText = True,-        onInt = True,-        onInteger = True,-        onBool = True,-        onNatural = True,-        onTime = True,-        onJson = False,-        onOptional = id,-        onList = const True,-        onMap = const True,-        onRef = \key -> case Map.lookup key (tgDeclarations graph) of-          Just ResolvedOpaque {} -> True-          _ -> False-      }--typeUsesToJson :: TypeGraph -> ResolvedTypeExpr -> Bool-typeUsesToJson = typeUsesParseJson--workqueueUsesRecordDot :: WorkqueueNode -> Bool-workqueueUsesRecordDot workqueue =-  not (null (wqPayload workqueue))-    || maybe False ((== "raw") . gkVia) (wqGroupKey workqueue)---- | Emit the versioned PGMQ envelope adapter.  The payload record remains--- symbol-free and dependency-light in Queue.hs; this runtime-facing module is--- the opt-in assembly point applications import into their Job values.-emitQueueCodec :: Text -> WorkqueueNode -> Text-emitQueueCodec genPrefix w =-  nl-    [ generatedBanner,-      "-- | Versioned job payload envelope: @{\\\"v\\\",\\\"t\\\",\\\"data\\\"}@.",-      "--",-      "-- Deploy workers before producers when raising its schema version. Do not",-      "-- adopt this codec on a non-empty bare-payload queue without draining it",-      "-- (or supplying a transitional codec), or in-flight messages will",-      "-- dead-letter. This is telemetry-neutral:",-      "-- docs/adr/0001-keiro-pgmq-job-processing-telemetry-contract.md owns",-      "-- spans and acknowledgement vocabulary.",-      "module " <> genPrefix <> ".QueueCodec (" <> stem <> "PayloadCodec, " <> stem <> "JobCodec) where",-      "",-      "import Data.List.NonEmpty (NonEmpty (..))",-      "import Keiro.Codec (Codec (..), EventType (..))",-      "import Keiro.PGMQ.Codec (JobCodec, keiroJobCodec)",-      "import " <> genPrefix <> ".Queue (" <> payloadTy <> ", encode" <> payloadTy <> ", parse" <> payloadTy <> ")",-      "",-      stem <> "PayloadCodec :: Codec " <> payloadTy,-      stem <> "PayloadCodec =",-      "  Codec",-      "    { eventTypes = EventType " <> tshow payloadTy <> " :| []",-      "    , eventType = \\_ -> EventType " <> tshow payloadTy,-      "    , schemaVersion = 1",-      "    , encode = encode" <> payloadTy,-      "    , decode = \\_ -> parse" <> payloadTy,-      "    , upcasters = []",-      "    }",-      "",-      stem <> "JobCodec :: JobCodec " <> payloadTy,-      stem <> "JobCodec = keiroJobCodec " <> stem <> "PayloadCodec"-    ]-  where-    payloadTy = wqPayloadName w-    stem = lowerFirst (T.concat (map pascal (T.splitOn "_" (wqName w))))---- | Emit the pgmq retry policy + JobOutcome disposition compiled against the--- LIVE @Keiro.PGMQ.Job@ runtime (RetryPolicy / JobOutcome / RetryDelay). This pins--- the dangerous inversions over the runtime types: storeFailure ⇒ Retry (transient)--- and decodeFailure ⇒ Dead (poison).-emitQueuePolicy :: Text -> WorkqueueNode -> Text-emitQueuePolicy genPrefix w =-  nl $-    [ generatedBanner,-      "module " <> genPrefix <> ".QueuePolicy",-      "  ( " <> outcomeType <> " (..)",-      "  , retryPolicy, jobOutcomeFor",-      "  , jobOrdering, jobTuningFor, queueProvision",-      "  ) where",-      "",-      "import Keiro.PGMQ.Job (" <> T.intercalate ", " queuePolicyImports <> ")",-      "",-      "jobOrdering :: JobOrdering",-      "jobOrdering = " <> orderingCtor,-      "",-      "-- Deployment owns visibility timeout, batch size, and polling; the spec owns ordering.",-      "jobTuningFor :: JobTuning -> JobTuning",-      "jobTuningFor = withOrdering jobOrdering",-      "",-      "-- Pass this to ensureJobQueueWith at worker startup. FIFO adds the required GIN index; the DLQ remains standard.",-      "queueProvision :: QueueProvision",-      "queueProvision = " <> provisionExpr,-      "",-      "retryPolicy :: RetryPolicy",-      "retryPolicy =",-      "  RetryPolicy",-      "    { maxRetries = " <> tshow' (wqMaxRetries w),-      "    , defaultRetryDelay = RetryDelay " <> windowText (wqDelay w),-      "    , useDeadLetter = " <> (if wqDlqOn w then "True" else "False"),-      "    }",-      "",-      "-- The consumer JobOutcome disposition over the spec's named domain outcomes,",-      "-- lowered to the live Keiro.PGMQ.Job.JobOutcome.",-      "data " <> outcomeType,-      "  = " <> T.intercalate "\n  | " (map (pascal . wqdOutcome) (wqDisposition w)),-      "  deriving stock (Eq, Show)",-      "",-      "jobOutcomeFor :: " <> outcomeType <> " -> JobOutcome",-      "jobOutcomeFor o = case o of"-    ]-      ++ ["  " <> pascal (wqdOutcome r) <> " -> " <> outcome (wqdAction r) | r <- wqDisposition w]-  where-    outcomeType = T.concat (map pascal (T.splitOn "_" (wqName w))) <> "Outcome"-    queuePolicyImports =-      [ "JobOrdering (..)",-        "JobOutcome (..)",-        "JobTuning",-        "QueueProvision",-        "RetryDelay (..)",-        "RetryPolicy (..)"-      ]-        <> ( case wqProvision w of-               WqStandard -> ["standardProvision"]-               WqUnlogged -> ["unloggedProvision"]-               WqPartitioned {} -> ["PartitionSpec (..)", "partitionedProvision"]-           )-        <> ["withFifoIndexProvision" | wqOrdering w /= WqUnordered]-        <> ["withOrdering"]-    orderingCtor = case wqOrdering w of-      WqUnordered -> "Unordered"-      WqFifoThroughput -> "FifoThroughput"-      WqFifoRoundRobin -> "FifoRoundRobin"-    provisionExpr = fifoWrap baseProvision-    fifoWrap expression = case wqOrdering w of-      WqUnordered -> expression-      _ -> "withFifoIndexProvision (" <> expression <> ")"-    baseProvision = case wqProvision w of-      WqStandard -> "standardProvision"-      WqUnlogged -> "unloggedProvision"-      WqPartitioned interval retention ->-        "partitionedProvision (PartitionSpec { partitionInterval = "-          <> tshow interval-          <> ", retentionInterval = "-          <> tshow retention-          <> " })"-    outcome IAckOk = "Done"-    outcome (IRetry win) = "Retry (RetryDelay " <> windowText win <> ")"-    outcome (IDeadLetter mr) = "Dead " <> tshow (fromMaybe "dead-lettered" mr)------------------------------------------------------------------------------------- First-class read models (EP-107)------------------------------------------------------------------------------------- | Emit an acyclic three-module read-model vertical. @ReadModelTable@ owns the--- qualified-table constant shared by the hand-owned query and the generated--- runtime record; @ReadModel@ re-exports it as part of the public surface.-scaffoldReadModel :: Context -> ReadModelNode -> [ScaffoldModule]-scaffoldReadModel ctx readModel =-  [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),-    generated "ReadModel" (emitReadModelGen ctx readModelModule tableModule readModelHolePrefix stem readModel),-    ScaffoldModule-      { modulePath = modulePathFor readModelHolePrefix "ReadModelHoles",-        moduleText = emitReadModelHoles tableModule readModelHolePrefix stem readModel,-        kind = HoleStub,-        origin = readModelOrigin-      }-  ]-  where-    nodeSegment = pascal (rmName readModel)-    stem = readModelStem readModel-    readModelModule = genPrefixFor ctx nodeSegment-    tableModule = readModelModule <> ".ReadModelTable"-    readModelHolePrefix = holePrefixFor ctx nodeSegment-    readModelOrigin = nodeOrigin "readmodel" (rmName readModel) (rmLoc readModel)-    generated leaf body =-      ScaffoldModule-        { modulePath = modulePathFor readModelModule leaf,-          moduleText = body,-          kind = Generated,-          origin = readModelOrigin-        }---- | Service-aware read-model generation adds a generated query contract only--- for the candidate typed query pair. Legacy read models stay on--- 'scaffoldReadModel' so their generated and create-once bytes remain exact.-scaffoldReadModelForService :: Context -> CheckedService -> ReadModelNode -> [ScaffoldModule]-scaffoldReadModelForService ctx service readModel = case queryTypes readModel of-  Nothing ->-    [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),-      generated "ReadModel" (emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix (ownerDerivedCursor service readModel) Nothing stem readModel),-      ScaffoldModule-        { modulePath = modulePathFor readModelHolePrefix "ReadModelHoles",-          moduleText = emitReadModelHoles tableModule readModelHolePrefix stem readModel,-          kind = HoleStub,-          origin = readModelOrigin-        }-    ]-  Just queryPair ->-    [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),-      generated "QueryContract" (emitReadModelQueryContract queryContractModule graph stem readModel queryPair),-      generated "ReadModel" (emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix (ownerDerivedCursor service readModel) (Just queryContractModule) stem readModel),-      ScaffoldModule-        { modulePath = modulePathFor readModelHolePrefix "ReadModelHoles",-          moduleText = emitTypedReadModelHoles tableModule queryContractModule readModelHolePrefix stem readModel,-          kind = HoleStub,-          origin = readModelOrigin-        }-    ]-  where-    nodeSegment = pascal (rmName readModel)-    stem = readModelStem readModel-    readModelModule = genPrefixFor ctx nodeSegment-    tableModule = readModelModule <> ".ReadModelTable"-    queryContractModule = readModelModule <> ".QueryContract"-    readModelHolePrefix = holePrefixFor ctx nodeSegment-    readModelOrigin = nodeOrigin "readmodel" (rmName readModel) (rmLoc readModel)-    graph = case checkedTypeGraph service of-      Left errors -> error ("checked read-model type graph failed: " <> show errors)-      Right value -> value-    generated leaf body =-      ScaffoldModule-        { modulePath = modulePathFor readModelModule leaf,-          moduleText = body,-          kind = Generated,-          origin = readModelOrigin-        }--ownerDerivedCursor :: CheckedService -> ReadModelNode -> Maybe Text-ownerDerivedCursor service readModel = do-  ownerName <- case [ supplyProjectionOwner supply-                    | supply <- resolvedProjectionSupplies (checkedProjectionSupplies service),-                      supplyQueryModel supply == rmName readModel-                    ] of-    [name] -> Just name-    _ -> Nothing-  owner <- case [candidate | NProjectionOwner candidate <- specNodes (checkedSpec service), poName candidate == ownerName] of-    [candidate] -> Just candidate-    _ -> Nothing-  case poDelivery owner of-    DeliveryInline -> Nothing-    DeliverySubscription -> poSubscription owner---- | Resolve a catalog-bound read model's physical binding to its backing--- target's coordinates, by name. An unbound or unresolvable model is returned--- unchanged; validation rejects those forms before scaffolding.-resolveCatalogReadModel :: Spec -> ReadModelNode -> ReadModelNode-resolveCatalogReadModel spec readModel = case rmGroup readModel of-  Nothing -> readModel-  Just _ ->-    let backingName = case rmBackingTarget readModel of-          Just name -> Just name-          Nothing -> case rmObservedTargets readModel of-            [single] -> Just single-            _ -> Nothing-     in case [target | NProjectionTarget target <- specNodes spec, Just (ptName target) == backingName] of-          target : _ -> readModel {rmSchema = ptSchema target, rmTable = ptTable target}-          [] -> readModel---- | Generate one service-level catalog facade and one create-once module that--- owns application handler/decoder bodies. The checked DSL graph owns every--- identity and relationship; the hole supplies only executable projection--- sets, never a second inventory.-scaffoldProjectionCatalog :: Context -> Spec -> [ScaffoldModule]-scaffoldProjectionCatalog ctx spec =-  scaffoldProjectionCatalogWith-    (projectionAggregateSourceFingerprint spec)-    ctx-    spec-    (analyzeProjectionSupplies spec)--scaffoldProjectionCatalogForService :: Context -> CheckedService -> [ScaffoldModule]-scaffoldProjectionCatalogForService ctx service =-  scaffoldProjectionCatalogWith-    (projectionAggregateSourceFingerprintForService service)-    ctx-    (checkedSpec service)-    (checkedProjectionSupplies service)--scaffoldProjectionCatalogWith :: (Name -> Text) -> Context -> Spec -> ProjectionSupplyAnalysis -> [ScaffoldModule]-scaffoldProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis-  | null catalogNodes = []-  | otherwise =-      [ ScaffoldModule-          { modulePath = modulePathFor (contextGeneratedPrefix ctx) "ProjectionCatalog",-            moduleText = emitProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis,-            kind = Generated,-            origin = "projection-catalog " <> contextName ctx-          },-        ScaffoldModule-          { modulePath = modulePathFor (holePrefixFor ctx "ProjectionCatalog") "ProjectionCatalogHoles",-            moduleText = emitProjectionCatalogHoles ctx spec owners revisions externalReads,-            kind = HoleStub,-            origin = "projection-catalog " <> contextName ctx-          }-      ]-  where-    catalogNodes = [() | node <- specNodes spec, isCatalogNode node]-    owners = sortOn poOrder [owner | NProjectionOwner owner <- specNodes spec]-    revisions = sortOn prvName [revision | NProjectionRevision revision <- specNodes spec]-    externalReads = sortOn (\externalRead -> (erName externalRead, erVersion externalRead)) [externalRead | NExternalRead externalRead <- specNodes spec]-    isCatalogNode NProjectionTarget {} = True-    isCatalogNode NRebuildGroup {} = True-    isCatalogNode NProjectionRevision {} = True-    isCatalogNode NExternalRead {} = True-    isCatalogNode NProjectionOwner {} = True-    isCatalogNode _ = False--emitProjectionCatalogWith :: (Name -> Text) -> Context -> Spec -> ProjectionSupplyAnalysis -> Text-emitProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis =-  nl $-    [ generatedBanner,-      "{-# LANGUAGE OverloadedStrings #-}",-      "module " <> moduleName,-      "  ( projectionCatalog",-      "  , validatedProjectionCatalog",-      "  , projectionCatalogInventory",-      "  , projectionCatalogRegistrations",-      "  , projectionCatalogAsyncRegistrations",-      "  , projectionCatalogQuerySupplies",-      "  , registerProjectionCatalog"-    ]-      ++ map (("  , " <>) . ownerSetName) owners-      ++ map (("  , " <>) . ownerInlineViewName) inlineOwners-      ++ map (("  , " <>) . aggregateInlineViewName . fst) aggregateInlineOwners-      ++ concatMap groupExports groups-      ++ [ "  ) where",-           "",-           "import Data.List.NonEmpty (NonEmpty (..))",-           "import Effectful (Eff, IOE, (:>))"-         ]-      ++ ["import Data.Map.Strict qualified as Map" | not (null revisions)]-      ++ concatMap aggregateImports aggregateSources-      ++ projectionImports-      ++ [ "import Keiro.Projection.Catalog qualified as Catalog",-           "import Keiro.ReadModel.Rebuild qualified as Rebuild",-           "import Kiroku.Store.Effect (Store)"-         ]-      ++ ["import Kiroku.Store.Types qualified as Kiroku" | any sourceUsesCategoryName sources]-      ++ ["import Kiroku.Store.Subscription.Types qualified as KirokuSubscription" | not (null asyncOwners)]-      ++ ["import " <> holesModule <> " qualified as Holes"]-      ++ map readModelImport readModels-      ++ [ "",-           "must :: Show error => Either error value -> value",-           "must = either (error . show) id"-         ]-      ++ concatMap ownerDefinition owners-      ++ concatMap aggregateInlineDefinition aggregateInlineOwners-      ++ [ "",-           "projectionCatalog :: Catalog.ProjectionCatalog",-           "projectionCatalog =",-           "  Catalog.ProjectionCatalog",-           "    " <> renderList sourceExpr sources,-           "    " <> renderList targetExpr targets,-           "    " <> renderList groupExpr groups,-           "    " <> renderList revisionExpr revisions,-           "    " <> renderList externalReadExpr externalReads,-           "    " <> renderList subscriptionExpr asyncOwners,-           "    " <> renderList dedupExpr asyncOwners,-           "    " <> renderList queryExpr boundReadModels,-           "    " <> renderList (("Catalog.SomeProjectionSet " <>) . ownerSetName) owners,-           "",-           "validatedProjectionCatalog :: Catalog.ValidatedProjectionCatalog",-           "validatedProjectionCatalog = case Catalog.validateProjectionCatalog projectionCatalog of",-           "  Catalog.Success catalog -> catalog",-           "  Catalog.Failure diagnostics -> error (\"keiro-dsl generated an invalid projection catalog: \" <> show diagnostics)",-           "",-           "projectionCatalogInventory :: Catalog.CatalogInventory",-           "projectionCatalogInventory = Catalog.catalogInventory validatedProjectionCatalog",-           "",-           "projectionCatalogRegistrations :: [Catalog.CatalogRegistration]",-           "projectionCatalogRegistrations = Catalog.catalogRegistrations validatedProjectionCatalog",-           "",-           "projectionCatalogAsyncRegistrations :: [Catalog.AsyncProjectionRegistration]",-           "projectionCatalogAsyncRegistrations = Catalog.asyncProjectionRegistrations validatedProjectionCatalog",-           "",-           "projectionCatalogQuerySupplies :: [Catalog.ResolvedQuerySupply]",-           "projectionCatalogQuerySupplies = Catalog.resolvedQuerySupplies validatedProjectionCatalog",-           "",-           "registerProjectionCatalog :: (Store :> es) => Eff es (Either Rebuild.CatalogRegistrationError [Rebuild.GroupRebuildMetadata])",-           "registerProjectionCatalog = Rebuild.registerProjectionCatalog validatedProjectionCatalog"-         ]-      ++ concatMap groupDefinitions groups-  where-    moduleName = contextGeneratedPrefix ctx <> ".ProjectionCatalog"-    holesModule = holePrefixFor ctx "ProjectionCatalog" <> ".ProjectionCatalogHoles"-    targets = [target | NProjectionTarget target <- specNodes spec]-    groups = [groupNode | NRebuildGroup groupNode <- specNodes spec]-    revisions = sortOn prvName [revision | NProjectionRevision revision <- specNodes spec]-    externalReads = sortOn (\externalRead -> (erName externalRead, erVersion externalRead)) [externalRead | NExternalRead externalRead <- specNodes spec]-    -- The catalog's list order is the declared total handler order. Keeping the-    -- sort here (rather than in the runtime) makes generated inventory and replay-    -- behavior agree even when declarations are arranged for readability.-    owners = sortOn poOrder [owner | NProjectionOwner owner <- specNodes spec]-    inlineOwners = [owner | owner <- owners, poDelivery owner == DeliveryInline]-    sources = nub (concatMap poSources owners)-    aggregateSources = nub [aggregateName | CatalogAggregate aggregateName <- sources]-    replayableAggregateSources =-      nub-        [ aggregateName-        | owner <- owners,-          poReplay owner == ProjectionReplayExplicit,-          CatalogAggregate aggregateName <- poSources owner-        ]-    asyncOwners = [owner | owner <- owners, poDelivery owner == DeliverySubscription]-    projectionImports = case (null asyncOwners, null inlineOwners) of-      (False, False) -> ["import Keiro.Projection (AsyncProjection (..), InlineProjection (..))"]-      (False, True) -> ["import Keiro.Projection (AsyncProjection (..))"]-      (True, False) -> ["import Keiro.Projection (InlineProjection (..))"]-      (True, True) -> []-    readModels = [readModel | NReadModel readModel <- specNodes spec]-    supplies = resolvedProjectionSupplies supplyAnalysis-    boundReadModels =-      [ readModel-      | supply <- supplies,-        readModel <- readModels,-        rmName readModel == supplyQueryModel supply-      ]-    readModelAlias readModel = "RM" <> pascal (rmName readModel)-    readModelImport readModel = "import " <> genPrefixFor ctx (pascal (rmName readModel)) <> ".ReadModel qualified as " <> readModelAlias readModel-    aggregateImports aggregateName =-      [ "import " <> genPrefixFor ctx aggregateName <> ".Codec qualified as " <> aggregateCodecAlias aggregateName-      | aggregateName `elem` replayableAggregateSources-      ]-        <> ["import " <> genPrefixFor ctx aggregateName <> ".Domain qualified as " <> aggregateDomainAlias aggregateName]-    aggregateCodecAlias aggregateName = pascal aggregateName <> "Codec"-    aggregateDomainAlias aggregateName = pascal aggregateName <> "Domain"-    sourceExpr source =-      "Catalog.SourceDeclaration "-        <> smart "mkSourceId" (catalogSourceId source)-        <> " "-        <> sourceScope source-        <> " "-        <> tshow (sourceFingerprint source)-        <> " "-        <> claim ("source " <> catalogSourceId source)-    sourceScope CatalogAll = "Catalog.AllStreams"-    sourceScope (CatalogCategory categoryName) = "(Catalog.CategorySource (Kiroku.CategoryName " <> tshow categoryName <> "))"-    sourceScope (CatalogAggregate aggregateName) = "(Catalog.CategorySource (Kiroku.CategoryName " <> tshow (lowerFirst aggregateName) <> "))"-    sourceFingerprint CatalogAll = "all-streams/generated-codec/v1"-    sourceFingerprint (CatalogCategory categoryName) = "category:" <> categoryName <> "/application-decoder/v1"-    sourceFingerprint (CatalogAggregate aggregateName) = aggregateFingerprint aggregateName-    sourceUsesCategoryName CatalogAll = False-    sourceUsesCategoryName CatalogCategory {} = True-    sourceUsesCategoryName CatalogAggregate {} = True-    targetExpr target =-      "Catalog.TargetDeclaration "-        <> smart "mkTargetId" (ptName target)-        <> " (Catalog.QualifiedTable "-        <> tshow (ptSchema target)-        <> " "-        <> tshow (ptTable target)-        <> ") "-        <> (case ptReset target of TargetClear -> "Catalog.ClearBeforeReplay"; TargetPreserve -> "Catalog.PreserveAndReconcile")-        <> " "-        <> renderList (smart "mkTargetId") (ptDependsOn target)-        <> " "-        <> claim ("target " <> ptName target)-    groupExpr groupNode =-      "Catalog.RebuildGroupDeclaration "-        <> smart "mkRebuildGroupId" (rgName groupNode)-        <> " "-        <> renderList (smart "mkTargetId") (rgOrder groupNode)-        <> " [] "-        <> claim ("rebuild-group " <> rgName groupNode)-    revisionExpr revision =-      "Catalog.ProjectionRevision "-        <> smart "mkProjectionRevisionId" (prvName revision)-        <> " "-        <> smart "mkRebuildGroupId" (prvGroup revision)-        <> " (Map.fromList "-        <> renderList (revisionTargetExpr revision) (prvTargets revision)-        <> ") "-        <> renderList (revisionLiveHandlerExpr revision) (revisionOwners revision)-        <> " "-        <> "[Catalog.RevisionReplayAdapter "-        <> tshow (prvName revision <> "/replay")-        <> " 1 "-        <> revisionRequiredTargets revision-        <> " Holes."-        <> revisionReplayName revision-        <> "] "-        <> "[Catalog.RevisionVerification "-        <> tshow (prvName revision <> "/verification")-        <> " 1 "-        <> revisionRequiredTargets revision-        <> " Holes."-        <> revisionVerificationName revision-        <> "] [] "-        <> claim ("projection-revision " <> prvName revision)-    revisionOwners revision = [owner | owner <- owners, poGroup owner == prvGroup revision]-    revisionLiveHandlerExpr revision owner =-      "Catalog.RevisionLiveHandler "-        <> tshow (prvName revision <> "/" <> poName owner <> "/live")-        <> " 1 "-        <> revisionLiveDeliveryExpr owner-        <> " "-        <> renderList (smart "mkTargetId") (poTargets owner)-        <> " Holes."-        <> revisionOwnerLiveName revision owner-    revisionLiveDeliveryExpr owner = case poDelivery owner of-      DeliveryInline ->-        "(Catalog.RevisionInlineDelivery "-          <> smart "mkProjectionId" (poName owner)-          <> " "-          <> tshow (poName owner)-          <> ")"-      DeliverySubscription ->-        "(Catalog.RevisionSubscriptionDelivery "-          <> smart "mkProjectionId" (poName owner)-          <> " "-          <> smart "mkSubscriptionId" (fromMaybe "" (poSubscription owner))-          <> " "-          <> smart "mkDedupKeyId" (fromMaybe "" (poDedup owner))-          <> ")"-    revisionTargetExpr revision target =-      "("-        <> smart "mkTargetId" (prtTarget target)-        <> ", Catalog.TargetProvisioner "-        <> tshow (prtProvisioner target)-        <> " "-        <> T.pack (show (prtProvisionerVersion target))-        <> " (Catalog.TargetSchemaVersion "-        <> tshow (prtSchemaVersion target)-        <> ") "-        <> tshow (prtExpectedShape target)-        <> " Holes."-        <> revisionProvisionName revision target-        <> " "-        <> tshow (prtValidator target)-        <> " "-        <> T.pack (show (prtValidatorVersion target))-        <> " (Just Holes."-        <> revisionValidateName revision target-        <> ") "-        <> renderList promotionObjectExpr (prtPromotionObjects target)-        <> ")"-    externalReadExpr externalRead =-      "Catalog.AllRowsExternalRead "-        <> smart "mkExternalReadContractId" (erName externalRead)-        <> " (Catalog.ExternalReadContractVersion "-        <> T.pack (show (erVersion externalRead))-        <> ") "-        <> smart "mkQueryModelId" (erQueryModel externalRead)-        <> " (Catalog.QualifiedSqlType "-        <> tshow (erResultSchema externalRead)-        <> " "-        <> tshow (erResultType externalRead)-        <> ") "-        <> tshow (externalReadShape externalRead)-        <> " "-        <> nonEmptyList (smart "mkProjectionRevisionId") (erCompatibleRevisions externalRead)-        <> " "-        <> T.pack (show (erSurfaceGeneration externalRead))-        <> " "-        <> claim ("external-read " <> erName externalRead <> " v" <> T.pack (show (erVersion externalRead)))-    externalReadShape externalRead = case [rmShape readModel | readModel <- readModels, rmName readModel == erQueryModel externalRead] of-      shape : _ -> shape-      [] -> "keiro-dsl invariant: validated external read query is missing"-    promotionObjectExpr promotionObject =-      "Catalog.PromotionObjectName "-        <> ( case rpoKind promotionObject of-               PromotionIndexNode -> "Catalog.PromotionIndex"-               PromotionConstraintNode -> "Catalog.PromotionConstraint"-               PromotionOwnedSequenceNode -> "Catalog.PromotionOwnedSequence"-           )-        <> " "-        <> tshow (rpoGenerationName promotionObject)-        <> " "-        <> tshow (rpoCanonicalName promotionObject)-    revisionRequiredTargets revision = renderList (smart "mkTargetId") (map prtTarget (prvTargets revision))-    subscriptionExpr owner =-      "Catalog.SubscriptionDeclaration "-        <> smart "mkSubscriptionId" (fromMaybe "" (poSubscription owner))-        <> " "-        <> tshow (fromMaybe "" (poSubscription owner))-        <> " "-        <> smart "mkSourceId" (catalogSourceId (ownerPrimarySource owner))-        <> " "-        <> checkpointOnMissingExpr owner-        <> " "-        <> claim ("projection-owner " <> poName owner <> " subscription")-    dedupExpr owner =-      "Catalog.DedupKeyDeclaration "-        <> smart "mkDedupKeyId" (fromMaybe "" (poDedup owner))-        <> " "-        <> tshow (fromMaybe "" (poDedup owner))-        <> " "-        <> claim ("projection-owner " <> poName owner <> " dedup")-    queryExpr readModel =-      "Catalog.SomeQueryModelBinding (Catalog.QueryModelBinding "-        <> smart "mkQueryModelId" (rmName readModel)-        <> " "-        <> readModelAlias readModel-        <> "."-        <> readModelStem readModel-        <> "ReadModel "-        <> smart "mkRebuildGroupId" (fromMaybe "" (rmGroup readModel))-        <> " "-        <> renderList (smart "mkTargetId") (sort (rmObservedTargets readModel))-        <> " "-        <> claim ("readmodel " <> rmName readModel)-        <> ")"-    ownerSetName owner = lowerFirst (pascal (poName owner)) <> "ProjectionSet"-    ownerInlineViewName owner = lowerFirst (pascal (poName owner)) <> "InlineProjections"-    aggregateInlineViewName aggregateName = lowerFirst (pascal aggregateName) <> "InlineProjections"-    aggregateInlineOwners =-      [ (aggregateName, matchingOwners)-      | aggregateName <- sort aggregateSources,-        let matchingOwners =-              [ owner-              | owner <- inlineOwners,-                ownerPrimarySource owner == CatalogAggregate aggregateName-              ],-        not (null matchingOwners)-      ]-    ownerEventType owner = case ownerPrimarySource owner of-      CatalogAggregate aggregateName -> aggregateDomainAlias aggregateName <> "." <> pascal aggregateName <> "Event"-      _ -> "Holes." <> pascal (poName owner) <> "Event"-    ownerDefinition owner =-      [ "",-        ownerSetName owner <> " :: Catalog.ProjectionSet " <> ownerEventType owner,-        ownerSetName owner <> " =",-        "  Catalog.ProjectionSet",-        "    " <> smart "mkSourceId" (catalogSourceId (ownerPrimarySource owner)),-        "    (Catalog.ProjectionDefinition",-        "      " <> smart "mkProjectionId" (poName owner),-        "      " <> smart "mkRebuildGroupId" (poGroup owner),-        "      " <> nonEmptyList (smart "mkTargetId") (poTargets owner),-        "      " <> replayPolicyExpr owner,-        "      (" <> handlerExpr owner <> " :| [])",-        "      " <> claim ("projection-owner " <> poName owner),-        "      :| [])",-        "    " <> claim ("projection-owner " <> poName owner <> " source")-      ]-        ++ if poDelivery owner == DeliveryInline-          then-            [ "",-              ownerInlineViewName owner <> " :: [InlineProjection " <> ownerEventType owner <> "]",-              ownerInlineViewName owner <> " = Catalog.typedInlineProjections validatedProjectionCatalog " <> ownerSetName owner-            ]-          else []-    aggregateInlineDefinition (aggregateName, sourceOwners) =-      [ "",-        aggregateInlineViewName aggregateName <> " :: [InlineProjection " <> aggregateDomainAlias aggregateName <> "." <> pascal aggregateName <> "Event]",-        aggregateInlineViewName aggregateName-          <> " = concat ["-          <> T.intercalate ", " (map ownerInlineViewName sourceOwners)-          <> "]"-      ]-    replayPolicyExpr owner = case poReplay owner of-      ProjectionLiveOnly reason -> "(Catalog.LiveOnly (Catalog.LiveOnlyReason " <> tshow reason <> "))"-      ProjectionReplayExplicit -> case ownerPrimarySource owner of-        CatalogAggregate aggregateName ->-          "(Catalog.Replayable (Catalog.replayAdapterFromCodec "-            <> aggregateCodecAlias aggregateName-            <> "."-            <> lowerFirst aggregateName-            <> "Codec Holes."-            <> ownerReplayApplyName owner-            <> "))"-        _ ->-          "(Catalog.Replayable (Catalog.ReplayAdapter Holes."-            <> ownerReplayDecodeName owner-            <> " Holes."-            <> ownerReplayApplyName owner-            <> "))"-    handlerExpr owner = case poDelivery owner of-      DeliveryInline ->-        "Catalog.InlineHandler (InlineProjection "-          <> tshow (poName owner)-          <> " Holes."-          <> ownerLiveApplyName owner-          <> ") "-          <> claim ("projection-owner " <> poName owner <> " inline-handler")-      DeliverySubscription ->-        "Catalog.AsyncHandler (AsyncProjection "-          <> tshow (fromMaybe "" (poDedup owner))-          <> " "-          <> tshow (ownerQueryRegistry owner)-          <> " "-          <> tshow (fromMaybe "" (poSubscription owner))-          <> " Holes."-          <> ownerLiveApplyName owner-          <> " Holes."-          <> ownerIdempotencyName owner-          <> ") "-          <> smart "mkSubscriptionId" (fromMaybe "" (poSubscription owner))-          <> " "-          <> smart "mkDedupKeyId" (fromMaybe "" (poDedup owner))-          <> " "-          <> claim ("projection-owner " <> poName owner <> " async-handler")-    ownerQueryRegistry owner = case matchingReadModels owner of-      readModel : _ -> registryNameFor (contextName ctx) readModel-      [] -> ""-    matchingReadModels owner =-      [ readModel-      | supply <- supplies,-        supplyProjectionOwner supply == poName owner,-        readModel <- boundReadModels,-        rmName readModel == supplyQueryModel supply-      ]-    ownerLiveApplyName owner = "apply" <> pascal (poName owner) <> "Live"-    ownerReplayApplyName owner = "apply" <> pascal (poName owner) <> "Replay"-    ownerReplayDecodeName owner = "decode" <> pascal (poName owner) <> "Replay"-    ownerIdempotencyName owner = lowerFirst (pascal (poName owner)) <> "IdempotencyKey"-    revisionProvisionName revision target = "provision" <> pascal (prvName revision) <> pascal (prtTarget target)-    revisionValidateName revision target = "validate" <> pascal (prvName revision) <> pascal (prtTarget target)-    revisionOwnerLiveName revision owner = "apply" <> pascal (prvName revision) <> pascal (poName owner) <> "Live"-    revisionReplayName revision = "apply" <> pascal (prvName revision) <> "Replay"-    revisionVerificationName revision = "verify" <> pascal (prvName revision)-    groupIdName groupNode = lowerFirst (pascal (rgName groupNode)) <> "RebuildGroupId"-    groupStartName groupNode = "start" <> pascal (rgName groupNode) <> "Rebuild"-    groupExports groupNode = ["  , " <> groupIdName groupNode, "  , " <> groupStartName groupNode]-    groupDefinitions groupNode =-      [ "",-        groupIdName groupNode <> " :: Catalog.RebuildGroupId",-        groupIdName groupNode <> " = " <> smart "mkRebuildGroupId" (rgName groupNode),-        "",-        groupStartName groupNode <> " :: (IOE :> es, Store :> es) => Rebuild.RebuildOptions -> Eff es (Either Rebuild.CatalogRebuildError Rebuild.RebuildRunReport)",-        groupStartName groupNode <> " = Rebuild.startCatalogRebuild validatedProjectionCatalog " <> groupIdName groupNode-      ]-    smart constructor value = "(must (Catalog." <> constructor <> " " <> tshow value <> "))"-    claim value = smart "mkClaimSite" value-    renderList render values = "[" <> T.intercalate ", " (map render values) <> "]"-    nonEmptyList _ [] = "error \"keiro-dsl invariant: validated projection owner has no targets\""-    nonEmptyList render (value : values) = "(" <> render value <> " :| " <> renderList render values <> ")"-    ownerPrimarySource owner = case poSources owner of-      source : _ -> source-      [] -> CatalogAll-    checkpointOnMissingExpr owner = case poCheckpointOnMissing owner of-      [CheckpointFromBeginning] -> "KirokuSubscription.FromBeginning"-      [CheckpointFromCurrentHead] -> "KirokuSubscription.FromCurrentHead"-      [CheckpointFail] -> "KirokuSubscription.FailIfMissing"-      _ -> "error \"keiro-dsl invariant: validated subscription owner must declare exactly one checkpoint-on-missing policy\""--emitProjectionCatalogHoles :: Context -> Spec -> [ProjectionOwnerNode] -> [ProjectionRevisionNode] -> [ExternalReadNode] -> Text-emitProjectionCatalogHoles ctx spec owners revisions externalReads =-  nl $-    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",-      "module " <> moduleName,-      "  ( " <> T.intercalate "\n  , " exports,-      "  ) where",-      ""-    ]-      ++ ["import " <> genPrefixFor ctx aggregateName <> ".Domain (" <> pascal aggregateName <> "Event)" | aggregateName <- aggregateSources]-      ++ ["import Data.Text (Text)" | not (null revisions)]-      ++ ["import Data.List.NonEmpty (NonEmpty (..))" | not (null externalReads)]-      ++ [ "import Hasql.Transaction qualified as Tx",-           "import Keiro.Projection.Catalog qualified as Catalog",-           "import Kiroku.Store.Types (EventId, RecordedEvent)",-           ""-         ]-      ++ ( if null externalReads-             then []-             else-               [ "must :: Show error => Either error value -> value",-                 "must = either (error . show) id",-                 ""-               ]-         )-      ++ concatMap ownerStubs owners-      ++ concatMap revisionStubs revisions-      ++ concatMap externalReadStubs externalReads-  where-    moduleName = holePrefixFor ctx "ProjectionCatalog" <> ".ProjectionCatalogHoles"-    aggregateSources = nub [aggregateName | owner <- owners, CatalogAggregate aggregateName <- poSources owner]-    exports = concatMap ownerExports owners <> concatMap revisionExports revisions <> map externalReadKeyedName externalReads-    ownerExports owner =-      [pascal (poName owner) <> "Event" | not (isAggregateSource owner)]-        <> [ownerLiveApplyName owner]-        <> [ownerIdempotencyName owner | poDelivery owner == DeliverySubscription]-        <> case poReplay owner of-          ProjectionLiveOnly _ -> []-          ProjectionReplayExplicit -> [ownerReplayApplyName owner] <> [ownerReplayDecodeName owner | not (isAggregateSource owner)]-    ownerStubs owner =-      ["-- Projection owner " <> poName owner <> " (order " <> T.pack (show (poOrder owner)) <> ")."]-        <> ["data " <> ownerEventType owner <> " = " <> ownerEventType owner | not (isAggregateSource owner)]-        <> [ownerLiveSignature owner, ownerLiveApplyName owner <> " = error \"HOLE: fill " <> poName owner <> " live apply\""]-        <> ( if poDelivery owner == DeliverySubscription-               then-                 [ ownerIdempotencyName owner <> " :: RecordedEvent -> EventId",-                   ownerIdempotencyName owner <> " = error \"HOLE: return the durable event id for " <> poName owner <> "\""-                 ]-               else []-           )-        <> replayStubs owner-        <> [""]-    revisionExports revision =-      concatMap (\target -> [revisionProvisionName revision target, revisionValidateName revision target]) (prvTargets revision)-        <> map (revisionOwnerLiveName revision) (revisionOwners revision)-        <> [revisionReplayName revision, revisionVerificationName revision]-    revisionStubs revision =-      ["-- Projection revision " <> prvName revision <> "."]-        <> concatMap targetStubs (prvTargets revision)-        <> concatMap liveStubs (revisionOwners revision)-        <> [ revisionReplayName revision <> " :: Catalog.PhysicalTargets -> RecordedEvent -> Tx.Transaction (Either Catalog.ReplayDecodeError Bool)",-             revisionReplayName revision <> " = error \"HOLE: replay revision " <> prvName revision <> " through PhysicalTargets\"",-             revisionVerificationName revision <> " :: Catalog.PhysicalTargets -> Tx.Transaction (Either Text ())",-             revisionVerificationName revision <> " = error \"HOLE: verify revision " <> prvName revision <> " staging targets\"",-             ""-           ]-      where-        liveStubs owner =-          [ revisionOwnerLiveName revision owner <> " :: Catalog.PhysicalTargets -> RecordedEvent -> Tx.Transaction ()",-            revisionOwnerLiveName revision owner <> " = error \"HOLE: apply " <> poName owner <> " live events for revision " <> prvName revision <> " through its owned PhysicalTargets\""-          ]-        targetStubs target =-          [ revisionProvisionName revision target <> " :: Catalog.TargetProvisioningContext -> Tx.Transaction ()",-            revisionProvisionName revision target <> " = error \"HOLE: provision target " <> prtTarget target <> " for revision " <> prvName revision <> "\"",-            revisionValidateName revision target <> " :: Catalog.TargetProvisioningContext -> Tx.Transaction (Either [Catalog.TargetSchemaViolation] Catalog.TargetSchemaEvidence)",-            revisionValidateName revision target <> " = error \"HOLE: validate target " <> prtTarget target <> " for revision " <> prvName revision <> "\""-          ]-    externalReadStubs externalRead =-      [ "-- Keyed alternative for external-read " <> erName externalRead <> " v" <> T.pack (show (erVersion externalRead)) <> ".",-        "-- Supply typed arguments plus an application-owned private SQL function; do not grant callers access to that inner function.",-        externalReadKeyedName externalRead <> " :: [Catalog.SqlFunctionArgument] -> Catalog.QualifiedFunction -> Int -> Catalog.ExternalReadContract",-        externalReadKeyedName externalRead <> " arguments privateImplementation privateImplementationVersion =",-        "  Catalog.KeyedExternalRead",-        "    " <> smart "mkExternalReadContractId" (erName externalRead),-        "    (Catalog.ExternalReadContractVersion " <> T.pack (show (erVersion externalRead)) <> ")",-        "    " <> smart "mkQueryModelId" (erQueryModel externalRead),-        "    arguments",-        "    (Catalog.QualifiedSqlType " <> tshow (erResultSchema externalRead) <> " " <> tshow (erResultType externalRead) <> ")",-        "    privateImplementation",-        "    privateImplementationVersion",-        "    " <> tshow (externalReadShape externalRead),-        "    " <> nonEmptyList (smart "mkProjectionRevisionId") (erCompatibleRevisions externalRead),-        "    " <> T.pack (show (erSurfaceGeneration externalRead)),-        "    " <> smart "mkClaimSite" ("external-read " <> erName externalRead <> " v" <> T.pack (show (erVersion externalRead)) <> " keyed helper"),-        ""-      ]-    replayStubs owner = case poReplay owner of-      ProjectionLiveOnly _ -> []-      ProjectionReplayExplicit ->-        ( if not (isAggregateSource owner)-            then-              [ ownerReplayDecodeName owner <> " :: RecordedEvent -> Catalog.ReplayDecodeResult " <> ownerEventType owner,-                ownerReplayDecodeName owner <> " = error \"HOLE: classify and decode every " <> poName owner <> " source event\""-              ]-            else []-        )-          <> [ ownerReplayApplyName owner <> " :: " <> ownerEventType owner <> " -> RecordedEvent -> Tx.Transaction ()",-               ownerReplayApplyName owner <> " = error \"HOLE: fill " <> poName owner <> " replay apply without live-only side effects\""-             ]-    ownerLiveSignature owner =-      ownerLiveApplyName owner <> " :: " <> case poDelivery owner of-        DeliveryInline -> ownerEventType owner <> " -> RecordedEvent -> Tx.Transaction ()"-        DeliverySubscription -> "RecordedEvent -> Tx.Transaction ()"-    ownerEventType owner = case ownerPrimarySource owner of-      CatalogAggregate aggregateName -> pascal aggregateName <> "Event"-      _ -> pascal (poName owner) <> "Event"-    isAggregateSource owner = case ownerPrimarySource owner of CatalogAggregate {} -> True; _ -> False-    ownerPrimarySource owner = case poSources owner of source : _ -> source; [] -> CatalogAll-    ownerLiveApplyName owner = "apply" <> pascal (poName owner) <> "Live"-    ownerReplayApplyName owner = "apply" <> pascal (poName owner) <> "Replay"-    ownerReplayDecodeName owner = "decode" <> pascal (poName owner) <> "Replay"-    ownerIdempotencyName owner = lowerFirst (pascal (poName owner)) <> "IdempotencyKey"-    revisionProvisionName revision target = "provision" <> pascal (prvName revision) <> pascal (prtTarget target)-    revisionValidateName revision target = "validate" <> pascal (prvName revision) <> pascal (prtTarget target)-    revisionOwners revision = [owner | owner <- owners, poGroup owner == prvGroup revision]-    revisionOwnerLiveName revision owner = "apply" <> pascal (prvName revision) <> pascal (poName owner) <> "Live"-    revisionReplayName revision = "apply" <> pascal (prvName revision) <> "Replay"-    revisionVerificationName revision = "verify" <> pascal (prvName revision)-    externalReadKeyedName externalRead = lowerFirst (pascal (erName externalRead)) <> "V" <> T.pack (show (erVersion externalRead)) <> "KeyedExternalRead"-    externalReadShape externalRead = case [rmShape readModel | NReadModel readModel <- specNodes spec, rmName readModel == erQueryModel externalRead] of-      shape : _ -> shape-      [] -> "keiro-dsl invariant: validated external read query is missing"-    smart constructor value = "(must (Catalog." <> constructor <> " " <> tshow value <> "))"-    nonEmptyList _ [] = "error \"keiro-dsl invariant: validated external read has no compatible revisions\""-    nonEmptyList render (value : values) = "(" <> render value <> " :| [" <> T.intercalate ", " (map render values) <> "])"--catalogSourceId :: CatalogSource -> Text-catalogSourceId CatalogAll = "all"-catalogSourceId (CatalogCategory categoryName) = "category:" <> categoryName-catalogSourceId (CatalogAggregate aggregateName) = "aggregate:" <> aggregateName--modulePathFor :: Text -> Text -> FilePath-modulePathFor prefix leaf = T.unpack (T.replace "." "/" prefix <> "/" <> leaf <> ".hs")--readModelStem :: ReadModelNode -> Text-readModelStem = lowerFirst . T.concat . map pascal . T.splitOn "_" . rmName--emitReadModelTable :: Text -> Text -> ReadModelNode -> Text-emitReadModelTable tableModule stem readModel =-  nl-    [ generatedBanner,-      "module " <> tableModule <> " (" <> qualifiedName <> ") where",-      "",-      "import Data.Text (Text)",-      "import Keiro.Connection (qualifyTable)",-      "",-      "-- The fully-qualified, double-quoted data-table reference.",-      qualifiedName <> " :: Text",-      qualifiedName <> " = qualifyTable " <> tshow (rmSchema readModel) <> " " <> tshow (rmTable readModel)-    ]-  where-    qualifiedName = stem <> "QualifiedTable"--emitReadModelQueryContract :: Text -> TypeGraph -> Text -> ReadModelNode -> ReadModelQueryTypes -> Text-emitReadModelQueryContract queryContractModule graph stem readModel queryPair =-  nl $-    [ generatedBanner,-      "module " <> queryContractModule,-      "  ( " <> queryInputType,-      "  , " <> queryResultType,-      "  ) where",-      ""-    ]-      <> imports-      <> ["" | not (null imports)]-      <> [ "type " <> queryInputType <> " = " <> renderType inputExpression,-           "type " <> queryResultType <> " = " <> renderType resultExpression-         ]-  where-    queryInputType = pascal stem <> "QueryInput"-    queryResultType = pascal stem <> "QueryResult"-    inputExpression = resolve "input" (inputLoc queryPair) (input queryPair)-    resultExpression = resolve "result" (resultLoc queryPair) (result queryPair)-    expressions = [inputExpression, resultExpression]-    plans = map plan expressions-    references = Set.unions (map consumerTypeReferences plans)-    reservedNames = Set.fromList [queryInputType, queryResultType, "Map", "Natural", "Text", "UTCTime", "Value"]-    importPlan = planImportsOrDie queryContractModule reservedNames references-    imports =-      ["import Data.Aeson (Value)" | any typeUsesJson expressions]-        <> ["import Data.Map.Strict (Map)" | any typeUsesMap expressions]-        <> ["import Data.Text (Text)" | any typeUsesText expressions]-        <> ["import Data.Time (UTCTime)" | any typeUsesTime expressions]-        <> ["import Numeric.Natural (Natural)" | any typeUsesNatural expressions]-        <> T.lines (renderPlannedImports importPlan)-    resolve position location expression =-      either-        (\failure -> error ("checked read-model query " <> T.unpack position <> " failed: " <> show failure))-        id-        (resolveTypeExpression graph owner location expression)-      where-        owner = "readmodel '" <> rmName readModel <> "' query " <> position-    plan expression =-      either-        (error . ("validated read-model consumer type planning failed: " <>) . show)-        id-        (planConsumerType graph expression)-    renderType expression =-      unHaskellTypeOccurrence $-        either-          (error . ("validated read-model consumer type rendering failed: " <>) . show)-          id-          (renderConsumerType importPlan graph expression)--emitReadModelGen :: Context -> Text -> Text -> Text -> Text -> ReadModelNode -> Text-emitReadModelGen ctx readModelModule tableModule readModelHolePrefix stem readModel =-  emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix Nothing Nothing stem readModel--emitReadModelGenWithContract :: Context -> Text -> Text -> Text -> Maybe Text -> Maybe Text -> Text -> ReadModelNode -> Text-emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix resolvedCursor queryContractModule stem readModel =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | emitsLegacyAsync]-      <> [ generatedBanner,-           "module " <> readModelModule <> ".ReadModel",-           "  ( " <> T.intercalate "\n  , " exports,-           "  ) where",-           ""-         ]-      ++ (if not catalogManaged then ["import Data.Functor (void)", "import Effectful (Eff, (:>))"] else [])-      ++ ["import " <> tableModule <> " (" <> qualifiedName <> ")"]-      ++ ["import " <> contractModule <> " (" <> queryInputType <> ", " <> queryResultType <> ")" | Just contractModule <- [queryContractModule]]-      ++ ["import " <> readModelHolePrefix <> ".ReadModelHoles (" <> T.intercalate ", " holeImports <> ")"]-      ++ asyncImports-      ++ [ "import Keiro.ReadModel (" <> readModelImports <> ")"-         ]-      ++ (if not catalogManaged then ["import Keiro.ReadModel.Rebuild qualified as Rebuild", "import Kiroku.Store.Effect (Store)", "import Kiroku.Store.Types (" <> kirokuTypes <> ")"] else [])-      ++ readModelDefinition-      ++ legacyLifecycleDefinitions-      ++ asyncDefinition-  where-    catalogManaged = rmGroup readModel /= Nothing-    ownerDerived = rmSupply readModel == OwnerDerivedSupply-    emitsLegacyAsync = not ownerDerived && not catalogManaged && legacyReadModelFeed readModel == Just RmSubscription-    registryName = registryNameFor (contextName ctx) readModel-    subscriptionName = subscriptionNameFor (contextName ctx) readModel-    asyncName = registryName <> "-async"-    readModelName = stem <> "ReadModel"-    qualifiedName = stem <> "QualifiedTable"-    registerName = "register" <> pascal stem-    startName = "start" <> pascal stem <> "Rebuild"-    finishName = "finish" <> pascal stem <> "Rebuild"-    abandonName = "abandon" <> pascal stem <> "Rebuild"-    asyncValueName = stem <> "AsyncProjection"-    queryInputType = pascal stem <> "QueryInput"-    queryResultType = pascal stem <> "QueryResult"-    queryName = stem <> "Query"-    applyName = "apply" <> pascal stem-    exports =-      [ readModelName,-        qualifiedName-      ]-        ++ (if not catalogManaged then [registerName, startName, finishName, abandonName] else [])-        ++ [asyncValueName | emitsLegacyAsync]-    holeImports = (if queryContractModule == Nothing then [queryInputType, queryResultType] else []) ++ [queryName] ++ [applyName | emitsLegacyAsync]-    asyncImports = ["import Keiro.Projection (AsyncProjection (..))" | emitsLegacyAsync]-    readModelImports =-      if ownerDerived-        then-          T.intercalate-            ", "-            ( ["QueryCursorAuthority (..)", "ReadModel", "ReadModelBlueprint (..)"]-                <> ( case rmFreshness readModel of-                       FreshnessImmediate -> ["immediateReadModel"]-                       FreshnessWaitForHead {} -> ["HeadScope (..)", "headWaitingReadModel"]-                   )-                <> if not catalogManaged then ["ReadModelMetadata", "registerReadModel"] else []-            )-        else-          "ConsistencyMode (..), ReadModel (..)"-            <> if catalogManaged-              then ", StrongScope (..)"-              else ", ReadModelMetadata, StrongScope (..), registerReadModel"-    kirokuTypes = case legacyReadModelFeed readModel of-      Just RmSubscription -> "GlobalPosition, RecordedEvent (..)"-      _ -> "GlobalPosition"-    projectionNames = case legacyReadModelFeed readModel of-      Just RmSubscription -> "[" <> tshow asyncName <> "]"-      _ -> "[]"-    readModelDefinition =-      [ "",-        readModelName <> " :: ReadModel " <> queryInputType <> " " <> queryResultType,-        readModelName <> " ="-      ]-        <> if ownerDerived-          then truthfulDefinition-          else legacyDefinition-    truthfulDefinition =-      ( case rmFreshness readModel of-          FreshnessImmediate -> ["  immediateReadModel " <> readModelBlueprintName]-          FreshnessWaitForHead scope ->-            [ "  case headWaitingReadModel " <> headScopeExpr scope <> " " <> readModelBlueprintName <> " of",-              "    Left definitionError -> error (\"keiro-dsl generated an invalid waiting read model: \" <> show definitionError)",-              "    Right model -> model"-            ]-      )-        <> [ "",-             readModelBlueprintName <> " :: ReadModelBlueprint " <> queryInputType <> " " <> queryResultType,-             readModelBlueprintName <> " =",-             "  ReadModelBlueprint",-             "    { name = " <> tshow registryName,-             "    , tableName = " <> tshow (rmTable readModel),-             "    , schema = " <> tshow (rmSchema readModel),-             "    , version = " <> tshow' (rmVersion readModel),-             "    , shapeHash = " <> tshow (rmShape readModel),-             "    , cursorAuthority = " <> maybe "NoQueryCursor" (("DurableQueryCursor " <>) . tshow) resolvedCursor,-             "    , query = " <> queryName,-             "    }"-           ]-    legacyDefinition =-      [ "  ReadModel",-        "    { name = " <> tshow registryName,-        "    , tableName = " <> tshow (rmTable readModel),-        "    , schema = " <> tshow (rmSchema readModel),-        "    , subscriptionName = " <> tshow subscriptionName,-        "    , version = " <> tshow' (rmVersion readModel),-        "    , shapeHash = " <> tshow (rmShape readModel),-        "    , defaultConsistency = " <> consistencyExpr legacyConsistency,-        "    , strongScope = " <> scopeExpr legacyScope,-        "    , query = " <> queryName,-        "    }"-      ]-    readModelBlueprintName = stem <> "ReadModelBlueprint"-    legacyConsistency = fromMaybe Eventual (legacyReadModelConsistency readModel)-    legacyScope = legacyReadModelScope readModel-    headScopeExpr RmEntireLog = "EntireVisibleLog"-    headScopeExpr (RmCategory categoryName) = "(CategoryVisibleHead " <> tshow categoryName <> ")"-    legacyLifecycleDefinitions-      | not catalogManaged =-          [ "",-            "-- Call once at projection startup before serving queries.",-            registerName <> " :: (Store :> es) => Eff es ()",-            registerName <> " =",-            "  void (registerReadModel " <> tshow registryName <> " " <> tshow' (rmVersion readModel) <> " " <> tshow (rmShape readModel) <> ")",-            "",-            startName <> " :: (Store :> es) => GlobalPosition -> Eff es ReadModelMetadata",-            startName <> " =",-            "  Rebuild.startRebuild " <> readModelName <> " " <> projectionNames,-            "",-            finishName <> " :: (Store :> es) => GlobalPosition -> Eff es (Either Rebuild.RebuildError ReadModelMetadata)",-            finishName <> " =",-            "  Rebuild.finishRebuild " <> readModelName <> " " <> projectionNames,-            "",-            abandonName <> " :: (Store :> es) => Eff es ReadModelMetadata",-            abandonName <> " = Rebuild.abandonRebuild " <> readModelName-          ]-      | otherwise = []-    asyncDefinition-      | emitsLegacyAsync =-          [ "",-            asyncValueName <> " :: AsyncProjection",-            asyncValueName <> " =",-            "  AsyncProjection",-            "    { name = " <> tshow asyncName,-            "    , readModelName = " <> tshow registryName,-            "    , subscriptionName = " <> tshow subscriptionName,-            "    , applyRecorded = " <> applyName,-            "    , idempotencyKey = \\recorded -> recorded.eventId",-            "    }"-          ]-      | otherwise = []-    consistencyExpr Strong = "Strong"-    consistencyExpr Eventual = "Eventual"-    scopeExpr Nothing = "EntireLog"-    scopeExpr (Just RmEntireLog) = "EntireLog"-    scopeExpr (Just (RmCategory categoryName)) = "CategoryHead " <> tshow categoryName--emitReadModelHoles :: Text -> Text -> Text -> ReadModelNode -> Text-emitReadModelHoles tableModule readModelHolePrefix stem readModel =-  nl $-    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",-      "module " <> readModelHolePrefix <> ".ReadModelHoles",-      "  ( " <> T.intercalate "\n  , " exports,-      "  ) where",-      "",-      "import " <> tableModule <> " (" <> qualifiedName <> ")",-      "import Hasql.Transaction qualified as Tx"-    ]-      ++ ["import Kiroku.Store.Types (RecordedEvent(..))" | emitsLegacyAsync]-      ++ [ "",-           "-- HOLE: replace these aliases with the real query input and result types.",-           "type " <> queryInputType <> " = ()",-           "type " <> queryResultType <> " = ()",-           "",-           "-- HOLE: query " <> qualifiedTableLiteral readModel <> " via " <> qualifiedName <> "; never rely on search_path.",-           "-- Declared columns:"-         ]-      ++ map (("--   " <>) . readModelColumnDoc) (rmColumns readModel)-      ++ [ queryName <> " :: " <> queryInputType <> " -> Tx.Transaction " <> queryResultType,-           queryName <> " _input = " <> qualifiedName <> " `seq` error " <> tshow ("HOLE: fill " <> rmName readModel <> " query")-         ]-      ++ applyStub-  where-    qualifiedName = stem <> "QualifiedTable"-    queryInputType = pascal stem <> "QueryInput"-    queryResultType = pascal stem <> "QueryResult"-    queryName = stem <> "Query"-    applyName = "apply" <> pascal stem-    emitsLegacyAsync = rmGroup readModel == Nothing && legacyReadModelFeed readModel == Just RmSubscription-    exports = [queryInputType, queryResultType, queryName] ++ [applyName | emitsLegacyAsync]-    applyStub-      | emitsLegacyAsync =-          [ "",-            "-- HOLE: apply one recorded event; runtime deduplication makes redelivery safe.",-            applyName <> " :: RecordedEvent -> Tx.Transaction ()",-            applyName <> " _recorded = error " <> tshow ("HOLE: fill " <> rmName readModel <> " async apply")-          ]-      | otherwise = []--emitTypedReadModelHoles :: Text -> Text -> Text -> Text -> ReadModelNode -> Text-emitTypedReadModelHoles tableModule queryContractModule readModelHolePrefix stem readModel =-  nl $-    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",-      "module " <> readModelHolePrefix <> ".ReadModelHoles",-      "  ( " <> T.intercalate "\n  , " exports,-      "  ) where",-      "",-      "import " <> tableModule <> " (" <> qualifiedName <> ")",-      "import " <> queryContractModule <> " (" <> queryInputType <> ", " <> queryResultType <> ")",-      "import Hasql.Transaction qualified as Tx"-    ]-      ++ ["import Kiroku.Store.Types (RecordedEvent(..))" | emitsLegacyAsync]-      ++ [ "",-           "-- HOLE: query " <> qualifiedTableLiteral readModel <> " via " <> qualifiedName <> "; never rely on search_path.",-           "-- The generated QueryContract owns query input/result type identity.",-           "-- Declared columns:"-         ]-      ++ map (("--   " <>) . readModelColumnDoc) (rmColumns readModel)-      ++ [ queryName <> " :: " <> queryInputType <> " -> Tx.Transaction " <> queryResultType,-           queryName <> " _input = " <> qualifiedName <> " `seq` error " <> tshow ("HOLE: fill " <> rmName readModel <> " query")-         ]-      ++ applyStub-  where-    qualifiedName = stem <> "QualifiedTable"-    queryInputType = pascal stem <> "QueryInput"-    queryResultType = pascal stem <> "QueryResult"-    queryName = stem <> "Query"-    applyName = "apply" <> pascal stem-    emitsLegacyAsync = rmGroup readModel == Nothing && legacyReadModelFeed readModel == Just RmSubscription-    exports = [queryName] ++ [applyName | emitsLegacyAsync]-    applyStub-      | emitsLegacyAsync =-          [ "",-            "-- HOLE: apply one recorded event; runtime deduplication makes redelivery safe.",-            applyName <> " :: RecordedEvent -> Tx.Transaction ()",-            applyName <> " _recorded = error " <> tshow ("HOLE: fill " <> rmName readModel <> " async apply")-          ]-      | otherwise = []--qualifiedTableLiteral :: ReadModelNode -> Text-qualifiedTableLiteral readModel = quoteSqlIdentifier (rmSchema readModel) <> "." <> quoteSqlIdentifier (rmTable readModel)--quoteSqlIdentifier :: Text -> Text-quoteSqlIdentifier identifier = "\"" <> T.replace "\"" "\"\"" identifier <> "\""--readModelColumnDoc :: RmColumn -> Text-readModelColumnDoc columnDecl =-  rmcName columnDecl-    <> " "-    <> rmcType columnDecl-    <> if rmcRequired columnDecl then " NOT NULL" else ""------------------------------------------------------------------------------------- Router + shared worker-policy lowering (EP-108)-----------------------------------------------------------------------------------scaffoldRouter :: Context -> RouterNode -> [ScaffoldModule]-scaffoldRouter ctx router =-  [ ScaffoldModule-      { modulePath = modulePathFor genPrefix "Router",-        moduleText = emitRouterGen genPrefix router,-        kind = Generated,-        origin = routerOrigin-      },-    ScaffoldModule-      { modulePath = modulePathFor holePrefix "RouterHoles",-        moduleText = emitRouterHoles holePrefix router,-        kind = HoleStub,-        origin = routerOrigin-      }-  ]-  where-    genPrefix = genPrefixFor ctx (rtId router)-    holePrefix = holePrefixFor ctx (rtId router)-    routerOrigin = nodeOrigin "router" (rtId router) (rtLoc router)---- | Service-aware router generation preserves the historical custom resolver--- vertical byte-for-byte, while a checked declarative selection becomes one--- fully generated module and owns no selection hole.-scaffoldRouterForService :: Context -> CheckedService -> RouterNode -> [ScaffoldModule]-scaffoldRouterForService ctx service router = case rvSource (rtResolve router) of-  ResolveDeclarative {} ->-    [ ScaffoldModule-        { modulePath = modulePathFor genPrefix "Router",-          moduleText = emitDeclarativeRouterGen ctx graph selection readModel targetAggregate targetCommand genPrefix router,-          kind = Generated,-          origin = routerOrigin-        }-    ]-  _ -> scaffoldRouter ctx router-  where-    spec = checkedSpec service-    genPrefix = genPrefixFor ctx (rtId router)-    routerOrigin = nodeOrigin "router" (rtId router) (rtLoc router)-    graph = case checkedTypeGraph service of-      Left errors -> error ("checked declarative router type graph failed: " <> show errors)-      Right value -> value-    selection = case checkRouterSelection (checkedLanguageContract service) graph spec router of-      Left diagnostics -> error ("checked declarative router selection failed: " <> show diagnostics)-      Right value -> value-    readModel = case [value | NReadModel value <- specNodes spec, rmName value == checkedQueryName (checkedQuery selection)] of-      [value] -> value-      _ -> error "checked declarative router read model disappeared"-    targetAggregate = case [aggregate | NAggregate aggregate <- specNodes spec, aggName aggregate == checkedTarget selection] of-      [aggregate] -> aggregate-      _ -> error "checked declarative router target aggregate disappeared"-    targetCommand = case [command | command <- aggCommands targetAggregate, cmdName command == checkedCommand selection] of-      [command] -> command-      _ -> error "checked declarative router target command disappeared"--emitRouterGen :: Text -> RouterNode -> Text-emitRouterGen genPrefix router =-  nl $-    [ generatedBanner,-      "module " <> genPrefix <> ".Router",-      "  ( " <> stem <> "Name",-      "  , " <> stem <> "WorkerOptions",-      "  ) where",-      "",-      "import Data.Text (Text)"-    ]-      ++ workerPolicyImports (rtPoison router)-      ++ [ "",-           "-- The STABLE router name. It participates in every target-keyed",-           "-- deterministicRouterCommandId; renaming it re-keys replayed dispatches.",-           stem <> "Name :: Text",-           stem <> "Name = " <> tshow (rtName router),-           "",-           "-- Runtime-owned dispatch id inputs: (name, key, sourceEventId,",-           "-- targetStreamName, occurrence). Target-keyed, not positional.",-           "",-           "-- Node-level worker policy lowered from the spec. Pass this value to",-           "-- Keiro.Router.runRouterWorkerWith; do not silently use defaultWorkerOptions."-         ]-      ++ workerOptionsLines (stem <> "WorkerOptions") (rtRejected router) (rtPoison router)-  where-    stem = lowerFirst (rtId router)--emitDeclarativeRouterGen :: Context -> TypeGraph -> CheckedRouterSelection -> ReadModelNode -> Aggregate -> Command -> Text -> RouterNode -> Text-emitDeclarativeRouterGen ctx graph selection readModel targetAggregate targetCommand genPrefix router =-  nl $-    [ generatedBanner,-      "module " <> genPrefix <> ".Router",-      "  ( " <> stem <> "Name",-      "  , " <> stem <> "WorkerOptions",-      "  , " <> stem <> "SelectionFingerprint",-      "  , " <> stem <> "SelectionContract",-      "  , " <> stem <> "Select",-      "  , " <> stem,-      "  ) where",-      "",-      "import Data.Text (Text)",-      "import Effectful (Eff, IOE, (:>))",-      "import " <> structuralProjectionModule ctx <> " qualified as StructuralProjections",-      "import " <> queryContractModule <> " (" <> queryInputType <> ")",-      "import " <> readModelModule <> ".ReadModel qualified as SelectionQuery",-      "import " <> targetModule <> ".Domain qualified as TargetDomain",-      "import " <> targetModule <> ".EventStream qualified as TargetStream"-    ]-      <> ["import " <> targetModule <> ".Projection qualified as TargetProjection" | not (null (rtProjections router))]-      <> [ "import Keiki.Core (HsPred, fieldWitnessGet)",-           "import Keiro.ProcessManager (PMCommand (..), PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))",-           "import Keiro.ReadModel (runQuery)",-           "import Keiro.Router",-           "  ( DeclarativeRouter (..)",-           "  , EmptySelectionPolicy (..)",-           "  , PartialDispatchPolicy (..)",-           "  , RedeliveryPolicy (..)",-           "  , RouterSelectionContract (..)",-           "  , RouterSelectionFailure (..)",-           "  , SelectionDedupe (..)",-           "  , SelectionFailurePolicy (..)",-           "  , SelectionFingerprint (..)",-           "  , SelectionIdentity (..)",-           "  , SelectionOrder (..)",-           "  , mkRecipientLimit",-           "  , mkSelectionVersion",-           "  )",-           "import Keiro.Stream (entityStream)",-           "import Kiroku.Store.Effect (Store)",-           "import Shibuya.Core.Ack (RetryDelay (..))"-         ]-      <> ["import Shibuya.Core.Types (Envelope)" | rtPoison router /= PolHalt]-      <> [ "",-           "-- The STABLE router name. It remains part of every target-keyed",-           "-- deterministic router command id; selection metadata never re-keys dispatches.",-           stem <> "Name :: Text",-           stem <> "Name = " <> tshow (rtName router),-           "",-           "-- SHA-256 of the checked selection semantics (locations and formatting excluded).",-           stem <> "SelectionFingerprint :: Text",-           stem <> "SelectionFingerprint = " <> tshow (checkedFingerprint selection),-           "",-           stem <> "SelectionContract :: RouterSelectionContract",-           stem <> "SelectionContract =",-           "  RouterSelectionContract",-           "    { identity = SelectionIdentity " <> tshow (checkedIdentity selection),-           "    , version = checkedSelectionVersion",-           "    , fingerprint = SelectionFingerprint " <> stem <> "SelectionFingerprint",-           "    , limit = checkedRecipientLimit",-           "    , order = OrderByTargetStream",-           "    , dedupe = DedupeByTargetStream",-           "    , emptyPolicy = " <> renderCheckedEmptyPolicy (checkedEmptyPolicy selection),-           "    , failurePolicy = " <> renderCheckedFailurePolicy (checkedFailurePolicy selection),-           "    , redeliveryPolicy = StableUnion",-           "    , partialPolicy = RetainSuccesses",-           "    }",-           "  where",-           "    checkedSelectionVersion = case mkSelectionVersion " <> T.pack (show (checkedVersion selection)) <> " of",-           "      Right value -> value",-           "      Left _ -> error \"keiro-dsl emitted a non-positive checked selection version\"",-           "    checkedRecipientLimit = case mkRecipientLimit " <> T.pack (show (checkedLimit selection)) <> " of",-           "      Right value -> value",-           "      Left _ -> error \"keiro-dsl emitted a non-positive checked recipient limit\"",-           "",-           stem <> "Select ::",-           "  (IOE :> es, Store :> es) =>",-           "  " <> queryInputType <> " ->",-           "  Eff es (Either RouterSelectionFailure [PMCommand TargetDomain." <> targetName <> "Command])",-           stem <> "Select input = do",-           "  queryResult <- runQuery Nothing SelectionQuery." <> readModelValue <> " input",-           "  pure $ case queryResult of",-           "    Left _ -> Left (SelectionQueryFailed " <> tshow ("read-model " <> checkedQueryName (checkedQuery selection) <> " query failed") <> ")",-           "    Right rows ->",-           "      Right",-           "        [ PMCommand",-           "            { target = entityStream TargetStream." <> targetCategory <> " (" <> renderCheckedScalar graph (checkedRecipient selection) <> ")",-           "            , command = " <> renderSelectionCommand graph selection targetCommand,-           "            }",-           "        | row <- rows",-           "        , " <> renderCheckedScalar graph (checkedPredicate selection),-           "        ]",-           "",-           stem <> " ::",-           "  (IOE :> es, Store :> es) =>",-           "  DeclarativeRouter",-           "    " <> queryInputType,-           "    (HsPred TargetDomain." <> targetName <> "Regs TargetDomain." <> targetName <> "Command)",-           "    TargetDomain." <> targetName <> "Regs",-           "    TargetDomain." <> targetName <> "Vertex",-           "    TargetDomain." <> targetName <> "Command",-           "    TargetDomain." <> targetName <> "Event",-           "    es",-           stem <> " =",-           "  DeclarativeRouter",-           "    { name = " <> stem <> "Name",-           "    , key = \\input -> " <> renderCheckedScalar graph (checkedKey selection),-           "    , selectionContract = " <> stem <> "SelectionContract",-           "    , select = " <> stem <> "Select",-           "    , targetEventStream = TargetStream." <> targetEventStream,-           "    , targetProjections = const " <> renderTargetProjections (rtProjections router),-           "    }",-           "",-           "-- Node-level worker policy. Pair it with runDeclarativeRouterWorkerWith.",-           "-- Selection empty/failure policy remains in the generated selection contract."-         ]-      <> workerOptionsLines (stem <> "WorkerOptions") (rtRejected router) (rtPoison router)-  where-    stem = lowerFirst (rtId router)-    targetName = aggName targetAggregate-    targetModule = genPrefixFor ctx targetName-    targetCategory = lowerFirst targetName <> "CommandCategory"-    targetEventStream = lowerFirst targetName <> "EventStream"-    readModelStemValue = readModelStem readModel-    queryInputType = pascal readModelStemValue <> "QueryInput"-    queryNodeSegment = pascal (rmName readModel)-    queryContractModule = genPrefixFor ctx queryNodeSegment <> ".QueryContract"-    readModelModule = genPrefixFor ctx queryNodeSegment-    readModelValue = readModelStemValue <> "ReadModel"-    renderTargetProjections [] = "[]"-    renderTargetProjections names = "[" <> T.intercalate ", " ["TargetProjection." <> lowerFirst name <> "Projection" | name <- names] <> "]"--renderCheckedEmptyPolicy :: CheckedEmptySelectionPolicy -> Text-renderCheckedEmptyPolicy = \case-  CheckedEmptyAck -> "EmptyAck"-  CheckedEmptyRetry -> "EmptyRetry"-  CheckedEmptyDeadLetter -> "EmptyDeadLetter"-  CheckedEmptyHalt -> "EmptyHalt"--renderCheckedFailurePolicy :: CheckedSelectionFailurePolicy -> Text-renderCheckedFailurePolicy = \case-  CheckedFailureRetry -> "FailureRetry"-  CheckedFailureDeadLetter -> "FailureDeadLetter"-  CheckedFailureHalt -> "FailureHalt"--renderCheckedScalar :: TypeGraph -> CheckedScalarExpr -> Text-renderCheckedScalar graph expression = case checkedScalarNode expression of-  CheckedPath root segments ->-    "(fieldWitnessGet StructuralProjections."-      <> witnessName segments-      <> " "-      <> rootName root-      <> ")"-  CheckedTextLiteral value -> tshow value-  CheckedIntegralLiteral value -> T.pack (show value)-  CheckedBoolLiteral value -> if value then "True" else "False"-  CheckedCompare operator left right ->-    "(" <> renderCheckedScalar graph left <> " " <> comparison operator <> " " <> renderCheckedScalar graph right <> ")"-  CheckedAnd left right -> "(" <> renderCheckedScalar graph left <> " && " <> renderCheckedScalar graph right <> ")"-  CheckedOr left right -> "(" <> renderCheckedScalar graph left <> " || " <> renderCheckedScalar graph right <> ")"-  where-    rootName SelectionInput = "input"-    rootName SelectionRow = "row"-    comparison OpEq = "=="-    comparison OpNeq = "/="-    comparison OpLt = "<"-    comparison OpLe = "<="-    comparison OpGt = ">"-    comparison OpGe = ">="-    witnessName [] = error "checked scalar path contained no fields"-    witnessName path@(first : _) =-      fromMaybe-        (error "checked scalar path has no generated structural witness")-        (projectionWitnessName graph (checkedPathOwner first) pointer)-      where-        pointer = T.concat ["/" <> escapePointer (checkedPathWireKey segment) | segment <- path]--renderSelectionCommand :: TypeGraph -> CheckedRouterSelection -> Command -> Text-renderSelectionCommand graph selection command =-  "TargetDomain."-    <> cmdName command-    <> " (TargetDomain."-    <> cmdName command-    <> "Data"-    <> T.concat [" (" <> renderCheckedScalar graph (commandExpression field) <> ")" | field <- cmdFields command]-    <> ")"-  where-    commandExpression field =-      fromMaybe-        (error "checked declarative router command field disappeared")-        (Map.lookup (aggregateFieldName field) (checkedCommandFields selection))--emitRouterHoles :: Text -> RouterNode -> Text-emitRouterHoles holePrefix router =-  nl-    [ "-- HAND-OWNED hole module for the router's behaviour-bearing bodies.",-      "-- keiro-dsl creates it once and never overwrites it.",-      "module " <> holePrefix <> ".RouterHoles () where",-      "",-      "-- HOLE resolve :: " <> inName (rtInput router) <> " -> Eff es [PMCommand targetCommand]",-      "--   Spec source: " <> resolveSourceText (rvSource (rtResolve router)) <> ".",-      "--   The spec's 'stable' keyword acknowledges that retry attempts accumulate",-      "--   the UNION of resolved target identities. Keep the recipient set stable",-      "--   for a source event whenever an exact recipient set matters.",-      "-- HOLE router value: assemble Keiro.Router.Router with name = " <> lowerFirst (rtId router) <> "Name,",-      "--   key, resolve, targetEventStream, and targetProjections; run it with",-      "--   runRouterWorkerWith " <> lowerFirst (rtId router) <> "WorkerOptions.",-      "-- HOLE targetProjections: spec projections = " <> renderNames (rtProjections router) <> ".",-      "-- NOTE on-duplicate AckOk is sound because Keiro.Router confirms a duplicate",-      "--   event id against the TARGET stream via confirmBenignDuplicate before",-      "--   returning PMCommandDuplicate. Hand-rolled dispatch paths must do likewise."-    ]-  where-    renderNames names = "[" <> T.intercalate ", " names <> "]"--resolveSourceText :: ResolveSource -> Text-resolveSourceText (ResolveReadModel name) = "read-model " <> name <> " (typically Keiro.ReadModel.runQuery)"-resolveSourceText ResolveHole = "typed resolver hole"-resolveSourceText (ResolveDeclarative selection) = "declarative selection " <> rsIdentity selection--workerPolicyImports :: PolicyChoice -> [Text]-workerPolicyImports poison =-  [ "import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))",-    "import Shibuya.Core.Ack (RetryDelay (..))"-  ]-    ++ if poison == PolHalt-      then []-      else ["import Effectful (Eff)", "import Shibuya.Core.Types (Envelope)"]--workerOptionsLines :: Text -> PolicyChoice -> PolicyChoice -> [Text]-workerOptionsLines valueName rejected poison =-  [ valueName <> signature,-    valueName <> argument <> " =",-    "  WorkerOptions",-    "    { poisonPolicy = " <> poisonExpr <> ",",-    "      rejectedCommandPolicy = " <> rejectedExpr rejected <> ",",-    "      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning",-    "      metrics = Nothing -- runtime configuration; install at call site",-    "    }"-  ]-  where-    signature = case poison of-      PolHalt -> " :: WorkerOptions es msg"-      _ -> " :: (Envelope msg -> Eff es ()) -> WorkerOptions es msg"-    argument = case poison of-      PolHalt -> ""-      _ -> " poisonCallback"-    poisonExpr = case poison of-      PolHalt -> "PoisonHalt"-      PolDeadLetter -> "PoisonDeadLetter poisonCallback"-      PolSkip -> "PoisonSkip poisonCallback"-    rejectedExpr = \case-      PolHalt -> "RejectedHalt"-      PolDeadLetter -> "RejectedDeadLetter"-      PolSkip -> "RejectedSkip"------------------------------------------------------------------------------------- Process manager + durable timer (EP-3)------------------------------------------------------------------------------------- | Emit the symbol-free deterministic wiring for a process manager + its timer--- into a @Generated@ module, plus a create-if-absent @ProcessHoles@ module for the--- behaviour-bearing bodies (the @handle@ reaction, the deadline window, and the--- fire command). The @Generated@ module contains no keiki symbolic operator (the--- saga's transducer is the separate aggregate hole), so the firewall invariant--- holds. The timer worker uses the spec's @max-attempts@ ceiling, never the--- dangerous @defaultTimerWorkerOptions@ (@Nothing@) default.-scaffoldProcess :: Context -> ProcessNode -> [ScaffoldModule]-scaffoldProcess ctx p =-  [ ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" genPrefix <> "/Process.hs"),-        moduleText = emitProcessGen sagaGenPrefix genPrefix holePrefix p,-        kind = Generated,-        origin = nodeOrigin "process" (procId p) (procLoc p)-      },-    ScaffoldModule-      { modulePath = T.unpack (T.replace "." "/" holePrefix <> "/ProcessHoles.hs"),-        moduleText = emitProcessHoles genPrefix holePrefix p,-        kind = HoleStub,-        origin = nodeOrigin "process" (procId p) (procLoc p)-      }-  ]-  where-    genPrefix = genPrefixFor ctx (procId p)-    holePrefix = holePrefixFor ctx (procId p)-    sagaGenPrefix = genPrefixFor ctx (pascal (sagaAgg (procSaga p)))--emitProcessGen :: Text -> Text -> Text -> ProcessNode -> Text-emitProcessGen sagaGenPrefix genPrefix _holePrefix p =-  nl $-    [ generatedBanner,-      "module " <> genPrefix <> ".Process",-      "  ( " <> lo <> "ProcessName",-      "  , " <> lo <> "Category",-      "  , " <> lo <> "ProcessWorkerOptions",-      "  , " <> lo <> "TimerRequest",-      "  , " <> lo <> "FireOutcome",-      "  ) where",-      "",-      "import Data.Aeson (Value, object, (.=))",-      "import Data.Text (Text)",-      "import qualified Data.Text as T",-      "import Data.Time (UTCTime)",-      "import Data.UUID (UUID)",-      "import qualified Data.UUID.V5 as UUID.V5",-      "import " <> sagaGenPrefix <> ".EventStream (" <> sagaEventStreamType <> ")",-      "import Keiro.Command (CommandError (..))",-      "import Keiro.Stream qualified as Stream",-      "import Keiro.Timer (TimerId (..), TimerRequest (..))"-    ]-      ++ workerPolicyImports (procPoison p)-      ++ [ "",-           "-- The define-once ProcessManager name (hole-kind 5: referenced, never retyped).",-           lo <> "ProcessName :: Text",-           lo <> "ProcessName = " <> tshow (procName p),-           "",-           "-- The validated saga stream category (hole-kind 5: referenced, never retyped).",-           "-- Saga streams are '<category>-<correlationId>' via Keiro.Stream.entityStream.",-           "-- categoryUnsafe is safe here because keiro-dsl check proved the literal legal.",-           lo <> "Category :: Stream.StreamCategory " <> sagaEventStreamType,-           lo <> "Category = Stream.categoryUnsafe " <> tshow categoryName,-           "",-           "-- Node-level worker policy lowered from the spec. Pass this value to",-           "-- Keiro.ProcessManager.runProcessManagerWorkerWith."-         ]-      ++ workerOptionsLines (lo <> "ProcessWorkerOptions") (procRejected p) (procPoison p)-      ++ [ "",-           "-- The deterministic timer-request builder: id derived from the correlation",-           "-- key (hole-kind 1), processManagerName referenced, payload from the spec.",-           "-- (timer id derived as uuidv5 of " <> tshow (idePrefix (tmId timer)) <> " <> correlationId)",-           lo <> "TimerRequest :: Text -> UTCTime -> TimerRequest",-           lo <> "TimerRequest correlationId fireAtTime =",-           "  TimerRequest",-           "    { timerId = TimerId (namedUuid (" <> tshow (idePrefix (tmId timer)) <> " <> correlationId))",-           "    , processManagerName = " <> lo <> "ProcessName",-           "    , correlationId = correlationId",-           "    , fireAt = fireAtTime",-           "    , payload = " <> payloadExpr (tmPayload timer),-           "    }",-           "",-           "-- The timer-fire disposition table (hole-kind 2), derived from the spec.",-           "-- on-reject => " <> showOutcome (onReject fd) <> " is the benign inversion.",-           "-- A duplicate append reaches on-error unless it is confirmed against the",-           "-- target stream. Use Keiro.ProcessManager.confirmBenignDuplicate:",-           "--   StreamName -> EventId -> CommandError -> Eff es Bool",-           "-- Fold True into the duplicate result and surface False as the failure.",-           lo <> "FireOutcome :: Either CommandError a -> Maybe ()",-           lo <> "FireOutcome result = case result of",-           "  Right{} -> " <> outcomeToMaybe (onOk fd),-           "  Left CommandRejected -> " <> outcomeToMaybe (onReject fd),-           "  Left (CommandAmbiguous _) -> " <> outcomeToMaybe (onAmbiguous fd) <> "  -- explicit definition-bug arm",-           "  Left{} -> " <> outcomeToMaybe (onError fd),-           "",-           "-- max-attempts = " <> tshow' (tmMaxAttempts timer) <> ", dead-letter = " <> tshow (tmDeadLetter timer),-           "-- (the timer worker must pass Just " <> tshow' (tmMaxAttempts timer) <> " to runTimerWorkerWith, never the",-           "--  defaultTimerWorkerOptions Nothing ceiling that retries forever).",-           "",-           "-- deterministic v5 UUID of a correlation-keyed string (hole-kind 1).",-           "namedUuid :: Text -> UUID",-           "namedUuid v = UUID.V5.generateNamed UUID.V5.namespaceURL (map (fromIntegral . fromEnum) (T.unpack v))"-         ]-  where-    lo = lowerFirst (procId p)-    sagaEventStreamType = pascal (sagaAgg (procSaga p)) <> "EventStreamDef"-    categoryName = staticCategory ("process " <> procId p) (sagaCategory (procSaga p))-    timer = procTimer p-    fd = fireDisposition (tmFire timer)---- | The timer payload, restricted to the spec's literal (@name=\"value\"@)--- bindings so it compiles in the deterministic builder. Bare fields and--- ref-valued bindings are input-driven (the agent-written hole), not emitted.-payloadExpr :: [FieldBinding] -> Text-payloadExpr fs = case [b | b <- fs, isLiteral b] of-  [] -> "object []"-  lits -> "object [ " <> T.intercalate ", " (map kv lits) <> " ]"-  where-    isLiteral b = maybe False (const True) (fbValue b >>= stripWrappingQuotes)-    kv b = tshow (fbName b) <> " .= (" <> maybe "\"\"" tshow (fbValue b >>= stripWrappingQuotes) <> " :: Value)"-    stripWrappingQuotes value = T.stripPrefix "\"" value >>= T.stripSuffix "\""--showOutcome :: FireOutcome -> Text-showOutcome OFired = "Fired"-showOutcome ORetry = "Retry"--outcomeToMaybe :: FireOutcome -> Text-outcomeToMaybe OFired = "Just ()  -- Fired"-outcomeToMaybe ORetry = "Nothing  -- Retry"--emitProcessHoles :: Text -> Text -> ProcessNode -> Text-emitProcessHoles _genPrefix holePrefix p =-  nl-    [ "-- HAND-OWNED hole module for the process manager's behaviour-bearing bodies.",-      "-- keiro-dsl creates it once and never overwrites it.",-      "module " <> holePrefix <> ".ProcessHoles () where",-      "",-      "-- HOLE handle: build the ProcessManagerAction (the self-advance",-      "--   '" <> advCommand (hAdvance (procHandle p)) <> "', the dispatch(es), and the timer) from the input.",-      "-- HOLE streams: build streamFor with entityStream " <> lowerFirst (procId p) <> "Category;",-      "--   build target streams with entityStream " <> lowerFirst (procTarget p) <> "CommandCategory. Never concatenate raw stream names.",-      "-- HOLE window: the deadline policy, e.g. surgeWindow :: NominalDiffTime;",-      "--   surgeDeadline observedAt = addUTCTime surgeWindow observedAt  (TIME INJECTED).",-      "-- HOLE fire command: construct " <> fireCommand (tmFire (procTimer p)) <> " for the timer fire,",-      "--   keyed by correlationId; the fired-event-id is the deterministic uuidv5 of",-      "--   " <> tshow (idePrefix (fireFiredEventId (tmFire (procTimer p)))) <> " <> correlationId.",-      "-- NOTE on-duplicate AckOk is sound because the runtime confirms a duplicate",-      "--   event id against the TARGET stream via confirmBenignDuplicate before",-      "--   returning PMCommandDuplicate. Its effective signature is:",-      "--     StreamName -> EventId -> CommandError -> Eff es Bool",-      "--   Hand-rolled paths must call it with the target stream and attempted event id,",-      "--   fold True into the duplicate result, and surface False as the original failure.",-      "--   Never pattern-match DuplicateEvent as success: event ids are globally unique."-    ]------------------------------------------------------------------------------------- Domain module-----------------------------------------------------------------------------------emitDomain :: Agg -> Text-emitDomain a =-  nl $-    renderGeneratedLanguagePragmas-      ( [ExtDeriveAnyClass | hasSnapshot a]-          <> [ExtDuplicateRecordFields | domainNeedsDuplicateRecordFields a]-          <> [ExtTemplateHaskell]-      )-      ++ [ generatedBanner,-           "module " <> aGenPrefix a <> ".Domain where",-           ""-         ]-      ++ ["import Data.Aeson (FromJSON, ToJSON)" | hasSnapshot a]-      ++ ["import Data.Proxy (Proxy (..))" | not (null (aRegs a))]-      ++ ["import Data.Text (Text)" | AggregateText `elem` aggregateTypes a]-      ++ [ "import GHC.Generics (Generic)",-           "import Keiki.Core (RegFile (..))"-         ]-      ++ ["import Keiki.Shape (CanonicalStateShape, CanonicalTypeName)" | hasSnapshot a]-      ++ generatedNominalDomainImports a-      ++ map ("import " <>) (domainStaticImports a)-      ++ T.lines (renderPlannedImports importPlan)-      ++ [ "import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)",-           "",-           sectionsOf-             [ [emitVertex a],-               map (emitRecord importPlan a) (aCommands a),-               [emitSum (aName a <> "Command") (aCommands a)],-               map (emitRecord importPlan a) (aEvents a),-               [emitSum (aName a <> "Event") (aEvents a)],-               [emitRegsType importPlan a, emitInitialRegs importPlan a],-               [ "$(deriveAggregateCtorsAll ''" <> aName a <> "Command ''" <> aName a <> "Regs)",-                 "",-                 "$(deriveWireCtorsAll ''" <> aName a <> "Event)"-               ]-             ]-         ]-  where-    importPlan = domainImportPlan a--domainNeedsDuplicateRecordFields :: Agg -> Bool-domainNeedsDuplicateRecordFields aggregate = hasDuplicateNames selectorNames-  where-    commandSelectors = concatMap (map (fieldSelector . fst) . rcFields) (aCommands aggregate)-    eventSelectors = concatMap (map (fieldSelector . fst) . rcFields) (aEvents aggregate)-    registerSelectors = map rrName (aRegs aggregate)-    -- deriveWireCtorsAll creates one event TermFields record that repeats each-    -- payload selector, so every field-bearing event contributes twice.-    selectorNames = commandSelectors <> eventSelectors <> eventSelectors <> registerSelectors--hasDuplicateNames :: [Text] -> Bool-hasDuplicateNames names = length names /= Set.size (Set.fromList names)--hasSnapshot :: Agg -> Bool-hasSnapshot = maybe False (const True) . aSnapshot--emitVertex :: Agg -> Text-emitVertex a =-  nl $-    [ "data " <> aVertexType a <> " = " <> T.intercalate " | " (map (vertexCtor a . stName) (aStates a)),-      "  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)"-    ]-      ++ ["  deriving anyclass (ToJSON, FromJSON)" | hasSnapshot a]-      ++ [ line-         | hasSnapshot a,-           line <--             [ "instance CanonicalStateShape " <> aVertexType a,-               "instance CanonicalTypeName " <> aVertexType a-             ]-         ]--emitRecord :: HaskellImportPlan -> Agg -> ResolvedCtor -> Text-emitRecord importPlan a rc =-  nl $-    [ "data " <> rcName rc <> "Data = " <> rcName rc <> "Data"-    ]-      ++ recordFields [(fieldSelector identity, renderDomainType importPlan a fieldType) | (identity, fieldType) <- rcFields rc]-      ++ ["  deriving stock (Generic, Eq, Show)"]--recordFields :: [(Text, Text)] -> [Text]-recordFields [] =-  ["  {"]-    <> ["  }"]-recordFields fs =-  [ lead i <> n <> " :: !" <> ty-  | (i, (n, ty)) <- zip [(0 :: Int) ..] fs-  ]-    ++ ["  }"]-  where-    lead 0 = "  { "-    lead _ = "  , "--emitSum :: Text -> [ResolvedCtor] -> Text-emitSum tyName ctors =-  nl $-    [firstLine] ++ restLines ++ ["  deriving stock (Generic, Eq, Show)"]-  where-    arm rc = rc' rc-    rc' rc = rcName rc <> " !" <> rcName rc <> "Data"-    (firstLine, restLines) = case ctors of-      [] -> ("data " <> tyName, [])-      (c : cs) ->-        ( "data " <> tyName <> " = " <> arm c,-          ["  | " <> arm c2 | c2 <- cs]-        )--emitRegsType :: HaskellImportPlan -> Agg -> Text-emitRegsType importPlan a =-  nl $-    ["type " <> aName a <> "Regs ="]-      ++ regListLines importPlan a (aRegs a)--regListLines :: HaskellImportPlan -> Agg -> [ResolvedRegister] -> [Text]-regListLines _ _ [] = ["  '[]"]-regListLines importPlan a rs =-  [ lead i <> "'(" <> tshow (rrName r) <> ", " <> renderDomainType importPlan a (rrType r) <> ")"-  | (i, r) <- zip [(0 :: Int) ..] rs-  ]-    ++ ["   ]"]-  where-    lead 0 = "  '[ "-    lead _ = "   , "--emitInitialRegs :: HaskellImportPlan -> Agg -> Text-emitInitialRegs importPlan a =-  nl $-    [ "initial" <> aName a <> "Regs :: RegFile " <> aName a <> "Regs",-      "initial" <> aName a <> "Regs ="-    ]-      ++ chain (aRegs a)-  where-    chain [] = ["  RNil"]-    chain rs =-      [ "  RCons (Proxy @" <> tshow (rrName r) <> ") " <> regInitialValue importPlan a r <> " $"-      | r <- init rs-      ]-        ++ ["  RCons (Proxy @" <> tshow (rrName lastR) <> ") " <> regInitialValue importPlan a lastR <> " RNil"]-      where-        lastR = last rs---- | The Haskell initial value for a register, by the category of its type.-regInitialValue :: HaskellImportPlan -> Agg -> ResolvedRegister -> Text-regInitialValue importPlan aggregate register = case rrInitial register of-  InitialId name -> case find ((== name) . resolvedNominalName) (aGeneratedNominals aggregate) >>= generatedIdSampleHaskell aggregate of-    Just value -> value-    Nothing -> renderRegisterInitial (rrInitial register)-  InitialNominal _ value -> renderReferenceOrDie importPlan (qualifiedValueReference value)-  InitialMapped _ value -> renderReferenceOrDie importPlan (qualifiedValueReference value)-  _ -> renderRegisterInitial (rrInitial register)--domainImportPlan :: Agg -> HaskellImportPlan-domainImportPlan aggregate =-  planImportsOrDie-    (aGenPrefix aggregate <> ".Domain")-    localDeclarations-    (Set.unions (map aggregateSourceReferences (domainAggregateSources aggregate)) <> initialReferences)-  where-    localDeclarations =-      Set.fromList-        ( [ aVertexType aggregate,-            aName aggregate <> "Command",-            aName aggregate <> "Event",-            aName aggregate <> "Regs"-          ]-            <> [rcName constructor <> "Data" | constructor <- aCommands aggregate <> aEvents aggregate]-            <> map resolvedNominalName (aGeneratedNominals aggregate)-        )-    initialReferences =-      Set.fromList-        ( [ qualifiedValueReference initialValue-          | declaration <- mappedUses aggregate,-            initialValue <- maybeToListText (mappedInitial declaration)-          ]-            <> [ qualifiedValueReference initialValue-               | resolvedType <- aggregateTypes aggregate,-                 AggregateNominal nominal <- [resolvedType],-                 ConsumerNominal binding <- [resolvedNominalOwnership nominal],-                 initialValue <- maybeToListText (consumerNominalInitial binding)-               ]-        )--generatedNominalDomainImports :: Agg -> [Text]-generatedNominalDomainImports aggregate-  | null nominals = []-  | otherwise =-      [ "import "-          <> generatedNominalModule (aContext aggregate)-          <> " ("-          <> T.intercalate ", " (concatMap importsFor nominals)-          <> ")"-      ]-  where-    nominals = stableNominals (aGeneratedNominals aggregate)-    importsFor nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix-        | Just _ <- idDomainContractFor (aLanguageContract aggregate) prefix ->-            resolvedNominalName nominal-              : ["parse" <> resolvedNominalName nominal | needsParser nominal]-      _ -> [resolvedNominalName nominal <> " (..)"]-    needsParser nominal =-      any-        (\register -> rrType register == AggregateNominal nominal && case rrInitial register of InitialId {} -> True; _ -> False)-        (aRegs aggregate)--domainStaticImports :: Agg -> [Text]-domainStaticImports aggregate =-  Set.toAscList (Set.delete timeTypeImport sourceImports <> Set.fromList timeImports)-  where-    sourceImports = Set.unions (map aggregateSourceStaticImports (domainAggregateSources aggregate))-    timeTypeImport = "Data.Time.Clock (UTCTime)"-    usesTimeType = AggregateTime `elem` aggregateTypes aggregate-    usesTimeLiteral = any (\register -> case rrInitial register of InitialTime {} -> True; _ -> False) (aRegs aggregate)-    timeImports-      | usesTimeLiteral =-          [ "Data.Time.Calendar (fromGregorian)",-            "Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)"-          ]-      | usesTimeType = [timeTypeImport]-      | otherwise = []--domainAggregateSources :: Agg -> [AggregateHaskellSource]-domainAggregateSources aggregate =-  map (aggregateConsumerHaskellSource (aSymbols aggregate)) (aggregateTypes aggregate)--aggregateTypes :: Agg -> [ResolvedAggregateType]-aggregateTypes aggregate =-  map snd (concatMap rcFields (aCommands aggregate <> aEvents aggregate)) <> map rrType (aRegs aggregate)--mappedUses :: Agg -> [ResolvedMappedDecl]-mappedUses a =-  [ declaration-  | resolvedType <--      map snd (concatMap rcFields (aCommands a <> aEvents a))-        <> map rrType (aRegs a),-    declaration <- maybeToListText (mappedDeclFor a resolvedType)-  ]--mappedDeclFor :: Agg -> ResolvedAggregateType -> Maybe ResolvedMappedDecl-mappedDeclFor a resolvedType = do-  key <- case resolvedType of-    AggregateMapped mappedKey -> Just mappedKey-    _ -> Nothing-  graph <- aTypeGraph a-  Map.lookup key (tgDeclarations graph)--mappedInitial :: ResolvedMappedDecl -> Maybe QualifiedValueName-mappedInitial (ResolvedStructural declaration _) = sdInitial declaration-mappedInitial (ResolvedOpaque declaration) = odInitial declaration--renderDomainType :: HaskellImportPlan -> Agg -> ResolvedAggregateType -> Text-renderDomainType importPlan aggregate resolvedType =-  either-    (error . ("validated aggregate Haskell reference failed: " <>) . show)-    id-    (renderAggregateHaskellSource importPlan (aggregateConsumerHaskellSource (aSymbols aggregate) resolvedType))--maybeToListText :: Maybe value -> [value]-maybeToListText = maybe [] pure------------------------------------------------------------------------------------- Codec module-----------------------------------------------------------------------------------emitCodec :: Agg -> Text-emitCodec a =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | codecUsesRecordDot a]-      ++ [ generatedBanner,-           "module " <> aGenPrefix a <> ".Codec (",-           "    " <> lowerFirst (aName a) <> "Codec,",-           "    parse" <> aName a <> "Event,",-           "    encode" <> aName a <> "Event,"-         ]-      ++ concatMap mappedExports (codecMappedDeclarations a)-      ++ [ ") where",-           "",-           "import " <> aGenPrefix a <> ".Domain"-         ]-      ++ generatedNominalCodecImports (aggregateCheckedService a) (aContext a) (codecGeneratedNominals a)-      ++ ["import Control.Monad (unless)" | codecUsesUnknownFieldRejection a]-      ++ [codecAesonImport a]-      ++ ["import Data.Aeson.Key qualified as Key" | codecUsesKeyMap a]-      ++ ["import Data.Aeson.KeyMap qualified as KeyMap" | codecUsesKeyMap a]-      ++ [ "import Data.Aeson.Types (" <> T.intercalate ", " (codecAesonTypesImports a) <> ")",-           "import Data.List.NonEmpty (NonEmpty (..))",-           "import Data.List.NonEmpty qualified as NonEmpty"-         ]-      ++ ( if codecUsesMap a-             then ["import Data.Map.Strict (Map)", "import Data.Map.Strict qualified as Map"]-             else []-         )-      ++ [ "import Data.Text (Text)",-           "import qualified Data.Text as T"-         ]-      ++ ["import Data.KindID qualified as KindID" | hasConsumerNominalIdCodec a]-      ++ ["import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)" | hasEnforcedConsumerNominalIdCodec a]-      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)" | hasConsumerNominalCodec a]-      ++ ["import Keiro.Codec.Structural (bindingFromShape, bindingToShape)" | hasStructuralMappedCodec a]-      ++ [ "import Keiro.Codec (Codec (..), EventType (..))",-           upcasterImport a-         ]-      ++ [nl (map ("import " <>) (codecMappedImports a)) | hasMappedCodec a]-      ++ [nl (map ("import " <>) (codecNominalImports a)) | hasConsumerNominalCodec a]-      ++ T.lines (renderPlannedImports importPlan)-      ++ [ "",-           emitEnumParsers a,-           emitConsumerNominalParsers importPlan a-         ]-      ++ [emitMappedCodecs importPlan a | hasMappedCodec a]-      ++ [ "",-           emitEventTypes a,-           "",-           emitCodecValue a,-           "",-           emitEncode importPlan a,-           "",-           emitDecode importPlan a,-           "",-           "mapLeftText :: Either String b -> Either Text b",-           "mapLeftText = either (Left . T.pack) Right",-           "",-           "renderExpectedEventTypes :: NonEmpty EventType -> String",-           "renderExpectedEventTypes =",-           "  T.unpack",-           "    . T.intercalate \", \"",-           "    . map (\\(EventType eventTypeName) -> eventTypeName)",-           "    . NonEmpty.toList"-         ]-      ++ ( if codecUsesOptionalFieldHelper a-             then-               [ "",-                 "parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue",-                 "parseOptionalField onMissing parseItem objectValue key =",-                 "  case KeyMap.lookup key objectValue of",-                 "    Nothing -> onMissing",-                 "    Just _ -> explicitParseField parseItem objectValue key"-               ]-             else []-         )-      ++ ( if codecUsesUnknownFieldRejection a-             then-               [ "",-                 "rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()",-                 "rejectUnknownFields label allowed objectValue =",-                 "  unless (null extras) (fail (label <> \" contains unknown fields: \" <> show extras))",-                 "  where",-                 "    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))"-               ]-             else []-         )-  where-    importPlan = codecImportPlan a-    mappedExports (ResolvedStructural declaration _) =-      [ "    encode" <> sdName declaration <> "Mapped,",-        "    decode" <> sdName declaration <> "Mapped,"-      ]-    mappedExports ResolvedOpaque {} = []--codecUsesRecordDot :: Agg -> Bool-codecUsesRecordDot = any (not . null . rcFields) . aEvents--hasMappedCodec :: Agg -> Bool-hasMappedCodec = not . null . codecMappedDeclarations--hasStructuralMappedCodec :: Agg -> Bool-hasStructuralMappedCodec = any isStructural . codecMappedDeclarations-  where-    isStructural ResolvedStructural {} = True-    isStructural ResolvedOpaque {} = False--codecAesonImport :: Agg -> Text-codecAesonImport aggregate =-  "import Data.Aeson (" <> T.intercalate ", " imports <> ")"-  where-    imports =-      [if codecUsesValueConstructors aggregate then "Value (..)" else "Value"]-        <> ["object" | codecUsesObject aggregate]-        <> ["parseJSON" | codecUsesParseJSON aggregate]-        <> ["toJSON" | codecUsesToJSON aggregate]-        <> ["withObject"]-        <> ["withText" | codecUsesWithText aggregate]-        <> ["(.:)" | codecUsesDotColon aggregate]-        <> ["(.=)" | codecUsesObject aggregate]--codecUsesObject :: Agg -> Bool-codecUsesObject aggregate =-  not (null (aEvents aggregate)) || any structuralUsesObject (codecMappedDeclarations aggregate)-  where-    structuralUsesObject (ResolvedStructural _ shape) = case shape of REnum {} -> False; _ -> True-    structuralUsesObject ResolvedOpaque {} = False--codecAesonTypesImports :: Agg -> [Text]-codecAesonTypesImports aggregate =-  ["Parser" | codecUsesParserType aggregate]-    <> ["explicitParseField" | codecUsesExplicitParseField aggregate]-    <> ["parseEither"]--codecUsesParserType :: Agg -> Bool-codecUsesParserType aggregate =-  codecUsesWithText aggregate || hasStructuralMappedCodec aggregate--codecUsesExplicitParseField :: Agg -> Bool-codecUsesExplicitParseField aggregate =-  codecUsesWithText aggregate || any structuralUsesExplicitParseField (codecMappedDeclarations aggregate)-  where-    structuralUsesExplicitParseField (ResolvedStructural _ shape) = case shape of-      RRecord _ _ fields -> not (null fields)-      REnum {} -> False-      RUnion {} -> True-    structuralUsesExplicitParseField ResolvedOpaque {} = False--codecUsesWithText :: Agg -> Bool-codecUsesWithText aggregate =-  any nominalUsesWithText (codecGeneratedNominals aggregate <> codecConsumerNominals aggregate)-    || any mappedUsesWithText (codecMappedDeclarations aggregate)-  where-    nominalUsesWithText nominal = case resolvedNominalRepresentation nominal of-      EnumRepresentation {} -> True-      IdRepresentation {} -> case resolvedNominalOwnership nominal of ConsumerNominal {} -> True; GeneratedNominal -> False-      ScalarRepresentation {} -> False-    mappedUsesWithText (ResolvedStructural _ shape) = case shape of-      REnum {} -> True-      RUnion {} -> True-      RRecord {} -> False-    mappedUsesWithText ResolvedOpaque {} = False--codecUsesDotColon :: Agg -> Bool-codecUsesDotColon aggregate = any fieldUsesDotColon (concatMap rcFields (aEvents aggregate))-  where-    fieldUsesDotColon (_, resolvedType) = case resolvedType of-      AggregateNominal nominal -> case (resolvedNominalOwnership nominal, resolvedNominalRepresentation nominal) of-        (GeneratedNominal, EnumRepresentation {}) -> False-        (ConsumerNominal {}, IdRepresentation {}) -> False-        (ConsumerNominal {}, EnumRepresentation {}) -> False-        _ -> True-      _ -> case fieldCat aggregate resolvedType of-        MappedStructuralCat {} -> False-        _ -> True--codecUsesKeyMap :: Agg -> Bool-codecUsesKeyMap aggregate = codecUsesOptionalFieldHelper aggregate || codecUsesUnknownFieldRejection aggregate--codecUsesUnknownFieldRejection :: Agg -> Bool-codecUsesUnknownFieldRejection = any declarationRejectsUnknown . codecMappedDeclarations-  where-    declarationRejectsUnknown (ResolvedStructural _ shape) = case shape of-      RRecord _ RejectUnknown _ -> True-      RUnion encoding _ -> ueUnknownFields encoding == RejectUnknown-      _ -> False-    declarationRejectsUnknown ResolvedOpaque {} = False--codecUsesMap :: Agg -> Bool-codecUsesMap = any declarationUsesMap . codecMappedDeclarations-  where-    declarationUsesMap (ResolvedStructural _ shape) = any typeUsesMap (shapeTypeExpressions shape)-    declarationUsesMap ResolvedOpaque {} = False--codecUsesParseJSON :: Agg -> Bool-codecUsesParseJSON aggregate = any (declarationUsesAesonConversion aggregate) (codecMappedDeclarations aggregate)--codecUsesToJSON :: Agg -> Bool-codecUsesToJSON aggregate =-  any directOpaqueField (concatMap rcFields (aEvents aggregate))-    || any (declarationUsesAesonConversion aggregate) (codecMappedDeclarations aggregate)-  where-    directOpaqueField (_, resolvedType) = case fieldCat aggregate resolvedType of MappedOpaqueCat {} -> True; _ -> False--codecUsesValueConstructors :: Agg -> Bool-codecUsesValueConstructors = any declarationUsesConstructors . codecMappedDeclarations-  where-    declarationUsesConstructors (ResolvedStructural _ shape) =-      case shape of REnum {} -> True; _ -> any typeUsesOptional (shapeTypeExpressions shape)-    declarationUsesConstructors ResolvedOpaque {} = False--declarationUsesAesonConversion :: Agg -> ResolvedMappedDecl -> Bool-declarationUsesAesonConversion aggregate (ResolvedStructural _ shape) =-  any (typeUsesAesonConversion aggregate) (shapeTypeExpressions shape)-declarationUsesAesonConversion _ ResolvedOpaque {} = False--shapeTypeExpressions :: ResolvedMappedShape -> [ResolvedTypeExpr]-shapeTypeExpressions = \case-  RRecord _ _ fields -> map rwfType fields-  REnum {} -> []-  RUnion _ arms -> mapMaybe rwaPayload arms--typeUsesMap :: ResolvedTypeExpr -> Bool-typeUsesMap =-  foldTypeExpr-    TypeExprAlgebra-      { onText = False,-        onInt = False,-        onInteger = False,-        onBool = False,-        onNatural = False,-        onTime = False,-        onJson = False,-        onOptional = id,-        onList = id,-        onMap = const True,-        onRef = const False-      }--typeUsesOptional :: ResolvedTypeExpr -> Bool-typeUsesOptional =-  foldTypeExpr-    TypeExprAlgebra-      { onText = False,-        onInt = False,-        onInteger = False,-        onBool = False,-        onNatural = False,-        onTime = False,-        onJson = False,-        onOptional = const True,-        onList = id,-        onMap = id,-        onRef = const False-      }--typeUsesAesonConversion :: Agg -> ResolvedTypeExpr -> Bool-typeUsesAesonConversion aggregate =-  foldTypeExpr-    TypeExprAlgebra-      { onText = True,-        onInt = True,-        onInteger = True,-        onBool = True,-        onNatural = True,-        onTime = True,-        onJson = False,-        onOptional = id,-        onList = const True,-        onMap = const True,-        onRef = \key -> case aTypeGraph aggregate >>= \graph -> Map.lookup key (tgDeclarations graph) of-          Just ResolvedOpaque {} -> True-          _ -> False-      }--codecUsesOptionalFieldHelper :: Agg -> Bool-codecUsesOptionalFieldHelper aggregate =-  any structuralHasOptionalField (codecMappedDeclarations aggregate)-  where-    structuralHasOptionalField (ResolvedStructural _ (RRecord _ _ fields)) =-      any ((== POptional) . rwfPresence) fields-    structuralHasOptionalField (ResolvedStructural _ _) = False-    structuralHasOptionalField ResolvedOpaque {} = False--hasConsumerNominalCodec :: Agg -> Bool-hasConsumerNominalCodec = not . null . codecConsumerNominals--hasConsumerNominalIdCodec :: Agg -> Bool-hasConsumerNominalIdCodec aggregate =-  any-    (\nominal -> case resolvedNominalRepresentation nominal of IdRepresentation {} -> True; _ -> False)-    (codecConsumerNominals aggregate)--hasEnforcedConsumerNominalIdCodec :: Agg -> Bool-hasEnforcedConsumerNominalIdCodec aggregate =-  any-    ( \nominal -> case resolvedNominalRepresentation nominal of-        IdRepresentation prefix -> isJust (idDomainContractFor (aLanguageContract aggregate) prefix)-        _ -> False-    )-    (codecConsumerNominals aggregate)--emitEnumParsers :: Agg -> Text-emitEnumParsers a =-  sectionsOf-    [ [emitEnumParser nominal | nominal <- codecGeneratedNominals a, EnumRepresentation {} <- [resolvedNominalRepresentation nominal]]-    ]--emitEnumParser :: ResolvedNominalType -> Text-emitEnumParser nominal = case resolvedNominalRepresentation nominal of-  EnumRepresentation constructors ->-    nl $-      [ "parse" <> name <> " :: Text -> Parser " <> name,-        "parse" <> name <> " = \\case"-      ]-        ++ ["  " <> tshow wire <> " -> pure " <> constructor | (constructor, wire) <- NE.toList constructors]-        ++ ["  tag -> " <> renderUnknownFailure name "tag" (map snd (NE.toList constructors))]-  _ -> error "non-enum reached generated enum parser emission"-  where-    name = resolvedNominalName nominal--emitConsumerNominalParsers :: HaskellImportPlan -> Agg -> Text-emitConsumerNominalParsers importPlan aggregate = sectionsOf [map emitParser (codecConsumerNominals aggregate)]-  where-    emitParser nominal = case (resolvedNominalRepresentation nominal, resolvedNominalOwnership nominal) of-      (IdRepresentation prefix, ConsumerNominal binding) ->-        nl $-          [ parserName nominal <> " :: Text -> Parser " <> renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding))-          ]-            <> parserBody nominal prefix binding-      (EnumRepresentation constructors, ConsumerNominal binding) ->-        nl $-          [ parserName nominal <> " :: Text -> Parser " <> renderReferenceOrDie importPlan (haskellTypeReference (consumerNominalHaskell binding)),-            parserName nominal <> " = \\case"-          ]-            <> [ "  "-                   <> tshow wire-                   <> " -> pure (nominalFromRepresentation "-                   <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding))-                   <> " "-                   <> renderReferenceOrDie importPlan (nominalRepresentationConstructorReference (aContext aggregate) nominal constructor)-                   <> ")"-               | (constructor, wire) <- NE.toList constructors-               ]-            <> ["  tag -> " <> renderUnknownFailure (resolvedNominalName nominal <> " wire value") "tag" (map snd (NE.toList constructors))]-      _ -> ""-    parserName nominal = "parse" <> resolvedNominalName nominal <> "Nominal"-    parserBody nominal prefix binding = case idDomainContractFor (aLanguageContract aggregate) prefix of-      Nothing ->-        [ parserName nominal <> " input = case KindID.parseText @" <> tshow prefix <> " input of",-          "  Left reason -> fail (show reason)",-          "  Right representation -> pure (nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding)) <> " representation)"-        ]-      Just _ ->-        [ parserName nominal <> " input = case validateIdDomainText (typeIdV7Domain " <> tshow prefix <> ") input of",-          "  Left reason -> fail (show reason)",-          "  Right () -> case KindID.parseText @" <> tshow prefix <> " input of",-          "    Left reason -> fail (show reason)",-          "    Right representation -> pure (nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding)) <> " representation)"-        ]--emitCodecValue :: Agg -> Text-emitCodecValue a =-  nl $-    [ lowerFirst (aName a) <> "Codec :: Codec " <> aName a <> "Event",-      lowerFirst (aName a) <> "Codec =",-      "  Codec",-      "    { eventTypes = " <> eventTypesName a,-      "    , eventType = \\case"-    ]-      ++ ["        " <> rcName e <> "{} -> EventType " <> tshow (rcName e) | e <- aEvents a]-      ++ [ "    , schemaVersion = " <> tshow' (maxEventVersion a),-           "    , encode = encode" <> aName a <> "Event",-           "    , decode = parse" <> aName a <> "Event",-           "    , upcasters = " <> upcastersExpr a,-           "    }"-         ]-      ++ upcasterRungDecls a--emitEventTypes :: Agg -> Text-emitEventTypes aggregate =-  nl-    [ eventTypesName aggregate <> " :: NonEmpty EventType",-      eventTypesName aggregate <> " = " <> eventTypesExpr-    ]-  where-    eventTypesExpr = case map rcName (aEvents aggregate) of-      [] -> "error \"no events\""-      event : rest -> "EventType " <> tshow event <> " :| [" <> T.intercalate ", " (map (("EventType " <>) . tshow) rest) <> "]"--eventTypesName :: Agg -> Text-eventTypesName aggregate = lowerFirst (aName aggregate) <> "EventTypes"---- | The codec's @schemaVersion@: the maximum declared event version (EP-2).-maxEventVersion :: Agg -> Int-maxEventVersion a = maximum (1 : map rcVersion (aEvents a))---- | One @(sourceVersion, upcasterName)@ entry per event that declares an--- @upcast from@. The upcaster name is per-event (e.g. @upcastFooV1@) and its--- body is a hole in the hand-owned Holes module.-upcasterEntries :: Agg -> [(Int, Text, Text)]-upcasterEntries a =-  [ (m, rcName e, "upcast" <> rcName e <> "V" <> tshow' m)-  | e <- aEvents a,-    Just m <- [rcUpcastFrom e]-  ]--upcastersExpr :: Agg -> Text-upcastersExpr a =-  "[" <> T.intercalate ", " ["(" <> tshow' m <> ", upcastRungV" <> tshow' m <> ")" | (m, _) <- upcasterRungs a] <> "]"---- | Group event-specific holes into one migration rung per aggregate-global--- source version.  Event metadata stamps every kind with the aggregate's--- schema version, so a rung must explicitly pass foreign event kinds through.-upcasterRungs :: Agg -> [(Int, [(Text, Text)])]-upcasterRungs a =-  [ (source, [(eventName, fn) | (_, eventName, fn) <- entries])-  | entries@((source, _, _) : _) <- groupBy sameSource (sortOn firstSource (upcasterEntries a))-  ]-  where-    firstSource (source, _, _) = source-    sameSource (source, _, _) (otherSource, _, _) = source == otherSource--upcasterRungDecls :: Agg -> [Text]-upcasterRungDecls a = concatMap rung (upcasterRungs a)-  where-    rung (source, entries) =-      [ "",-        "upcastRungV" <> tshow' source <> " :: EventType -> Value -> Either Text Value"-      ]-        ++ [ "upcastRungV" <> tshow' source <> " (EventType " <> tshow eventName <> ") value = " <> fn <> " value"-           | (eventName, fn) <- entries-           ]-        ++ [ "-- Kinds whose shape did not change at this rung pass through unchanged; their",-             "-- stamped version is aggregate-global, not their own shape history.",-             "upcastRungV" <> tshow' source <> " _ value = Right value"-           ]---- | When the codec references upcasters, it imports their (hole) definitions--- from the hand-owned Holes module.-upcasterImport :: Agg -> Text-upcasterImport a = case upcasterEntries a of-  [] -> ""-  es -> "import " <> aHolePrefix a <> ".Holes (" <> T.intercalate ", " [fn | (_, _, fn) <- es] <> ")"--emitEncode :: HaskellImportPlan -> Agg -> Text-emitEncode importPlan a =-  nl $-    [ "encode" <> aName a <> "Event :: " <> aName a <> "Event -> Value",-      "encode" <> aName a <> "Event = \\case"-    ]-      ++ concatMap encodeArm (aEvents a)-  where-    encodeArm e =-      [ "  " <> rcName e <> " payload ->",-        "    object"-      ]-        ++ [ lead i <> kv-           | (i, kv) <- zip [(0 :: Int) ..] (("\"kind\" .= (" <> tshow (rcName e) <> " :: Text)") : map encodeField (rcFields e))-           ]-        ++ ["      ]"]-    lead 0 = "      [ "-    lead _ = "      , "-    encodeField (identity, ty) =-      tshow (fieldWireKey identity)-        <> " .= "-        <> encodeFieldValue (fieldSelector identity) ty-    encodeFieldValue selector ty = case ty of-      AggregateNominal nominal -> encodeNominalValue nominal ("payload." <> selector)-      _ -> case fieldCat a ty of-        MappedStructuralCat {} -> encodeMapped ty ("payload." <> selector)-        MappedOpaqueCat {} -> encodeMapped ty ("payload." <> selector)-        _ -> "payload." <> selector-    encodeMapped (AggregateMapped key) value = case aTypeGraph a of-      Nothing -> error "mapped aggregate field has no resolved type graph"-      Just graph ->-        renderMappedEncode graph ConsumerValueBoundary (mappedCodecPlanOrDie graph (RRef key)) value-    encodeMapped _ _ = error "non-mapped aggregate type reached mapped codec lowering"-    encodeNominalValue nominal value = case resolvedNominalOwnership nominal of-      GeneratedNominal -> case resolvedNominalRepresentation nominal of-        IdRepresentation {} -> lowerFirst (resolvedNominalName nominal) <> "Text " <> value-        EnumRepresentation {} -> lowerFirst (resolvedNominalName nominal) <> "Text " <> value-        ScalarRepresentation {} -> value-      ConsumerNominal binding -> case resolvedNominalRepresentation nominal of-        IdRepresentation {} -> "KindID.toText (nominalToRepresentation " <> bindingName binding <> " " <> value <> ")"-        EnumRepresentation {} ->-          renderReferenceOrDie importPlan (nominalRepresentationEncoderReference (aContext a) nominal)-            <> " (nominalToRepresentation "-            <> bindingName binding-            <> " "-            <> value-            <> ")"-        ScalarRepresentation {} -> "nominalToRepresentation " <> bindingName binding <> " " <> value-    bindingName = renderReferenceOrDie importPlan . qualifiedValueReference . consumerNominalBinding--emitDecode :: HaskellImportPlan -> Agg -> Text-emitDecode importPlan a =-  nl $-    [ "parse" <> aName a <> "Event :: EventType -> Value -> Either Text " <> aName a <> "Event",-      "parse" <> aName a <> "Event (EventType tag) = mapLeftText . parseEither (withObject " <> tshow (aName a <> "Event") <> " go)",-      "  where",-      "    go o = do",-      "      case tag of"-    ]-      ++ concatMap decodeArm (aEvents a)-      ++ ["        _ -> " <> renderUnknownEventTypeFailure a "tag"]-  where-    decodeArm e =-      ["        " <> tshow (rcName e) <> " ->"]-        ++ case rcFields e of-          [] -> ["          pure (" <> rcName e <> " " <> rcName e <> "Data)"]-          fields ->-            [ "          " <> rcName e,-              "            <$> ( " <> rcName e <> "Data"-            ]-              ++ [ (if index == 0 then "                    <$> " else "                    <*> ") <> decodeField field-                 | (index, field) <- zip [(0 :: Int) ..] fields-                 ]-              ++ ["                )"]-    decodeField (identity, ty) = case ty of-      AggregateNominal nominal -> decodeNominalField (fieldWireKey identity) nominal-      _ -> case fieldCat a ty of-        MappedStructuralCat {} -> decodeMapped ty (fieldWireKey identity)-        MappedOpaqueCat {} -> "o .: " <> tshow (fieldWireKey identity)-        _ -> "o .: " <> tshow (fieldWireKey identity)-    decodeMapped (AggregateMapped mappedKey) key = case aTypeGraph a of-      Nothing -> error "mapped aggregate field has no resolved type graph"-      Just graph ->-        "explicitParseField "-          <> renderMappedParse graph ConsumerValueBoundary (mappedCodecPlanOrDie graph (RRef mappedKey))-          <> " o "-          <> tshow key-    decodeMapped _ _ = error "non-mapped aggregate type reached mapped codec lowering"-    decodeNominalField name nominal = case resolvedNominalOwnership nominal of-      GeneratedNominal -> case resolvedNominalRepresentation nominal of-        IdRepresentation prefix -> case idDomainContractFor (aLanguageContract a) prefix of-          Nothing -> "(" <> resolvedNominalName nominal <> " <$> o .: " <> tshow name <> ")"-          Just _ -> "(" <> legacyNominalConstructorName nominal <> " <$> o .: " <> tshow name <> ")"-        EnumRepresentation {} ->-          "explicitParseField (withText "-            <> tshow (resolvedNominalName nominal)-            <> " parse"-            <> resolvedNominalName nominal-            <> ") o "-            <> tshow name-        ScalarRepresentation {} -> "o .: " <> tshow name-      ConsumerNominal binding -> case resolvedNominalRepresentation nominal of-        IdRepresentation {} -> consumerNominalFieldParser name nominal-        EnumRepresentation {} -> consumerNominalFieldParser name nominal-        ScalarRepresentation {} -> "(nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding)) <> " <$> o .: " <> tshow name <> ")"-    consumerNominalFieldParser fieldName nominal =-      "explicitParseField (withText "-        <> tshow (resolvedNominalName nominal)-        <> " parse"-        <> resolvedNominalName nominal-        <> "Nominal) o "-        <> tshow fieldName--codecConsumerNominals :: Agg -> [ResolvedNominalType]-codecConsumerNominals aggregate =-  Map.elems . Map.fromList $-    [ (resolvedNominalName nominal, nominal)-    | event <- aEvents aggregate,-      (_, AggregateNominal nominal) <- rcFields event,-      ConsumerNominal {} <- [resolvedNominalOwnership nominal]-    ]--codecGeneratedNominals :: Agg -> [ResolvedNominalType]-codecGeneratedNominals aggregate =-  generatedNominalsInTypes-    [ resolvedType-    | event <- aEvents aggregate,-      (_, resolvedType) <- rcFields event-    ]--codecImportPlan :: Agg -> HaskellImportPlan-codecImportPlan aggregate =-  planImportsOrDie-    (aGenPrefix aggregate <> ".Codec")-    (Set.fromList [aName aggregate <> "Event"])-    (Set.fromList (nominalReferences <> mappedReferences <> nominalRepresentationReferences <> shapeReferences))-  where-    nominalReferences =-      [ reference-      | nominal <- codecConsumerNominals aggregate,-        ConsumerNominal binding <- [resolvedNominalOwnership nominal],-        reference <- qualifiedValueReference (consumerNominalBinding binding) : nominalParserTypeReferences nominal binding-      ]-    nominalParserTypeReferences nominal binding = case resolvedNominalRepresentation nominal of-      IdRepresentation {} -> [haskellTypeReference (consumerNominalHaskell binding)]-      EnumRepresentation {} -> [haskellTypeReference (consumerNominalHaskell binding)]-      ScalarRepresentation {} -> []-    mappedReferences =-      [ reference-      | ResolvedStructural declaration _ <- codecMappedDeclarations aggregate,-        reference <--          [ haskellTypeReference (sdHaskell declaration),-            qualifiedValueReference (sdBinding declaration)-          ]-      ]-    nominalRepresentationReferences =-      [ reference-      | nominal <- codecConsumerNominals aggregate,-        EnumRepresentation constructors <- [resolvedNominalRepresentation nominal],-        reference <--          nominalRepresentationEncoderReference (aContext aggregate) nominal-            : [ nominalRepresentationConstructorReference (aContext aggregate) nominal constructor-              | (constructor, _) <- NE.toList constructors-              ]-      ]-    shapeReferences =-      [ reference-      | ResolvedStructural declaration shape <- codecMappedDeclarations aggregate,-        reference <- structuralShapeReferences (aContext aggregate) declaration shape-      ]--codecNominalImports :: Agg -> [Text]-codecNominalImports _ = []--codecMappedImports :: Agg -> [Text]-codecMappedImports a = case aTypeGraph a of-  Nothing -> []-  Just graph ->-    sort . nub $-      [ hsModule (odHaskell declaration) <> " ()"-      | ResolvedOpaque declaration <- codecMappedDeclarations a-      ]-        <> [ hsModule (odHaskell declaration) <> " ()"-           | ResolvedStructural _ shape <- codecMappedDeclarations a,-             key <- directShapeRefs shape,-             Just (ResolvedOpaque declaration) <- [Map.lookup key (tgDeclarations graph)]-           ]--codecMappedDeclarations :: Agg -> [ResolvedMappedDecl]-codecMappedDeclarations a = case aTypeGraph a of-  Nothing -> []-  Just graph ->-    mapMaybe (\key -> Map.lookup key (tgDeclarations graph)) (sort (Map.keys selected))-    where-      roots =-        [ key-        | event <- aEvents a,-          (_, AggregateMapped key) <- rcFields event,-          Map.member key (tgDeclarations graph)-        ]-      selected =-        Map.fromList-          [ (key, ())-          | root <- roots,-            key <- root : maybe [] (Map.keys . Map.fromSet (const ())) (Map.lookup root (tgReachability graph))-          ]--directShapeRefs :: ResolvedMappedShape -> [MappedKey]-directShapeRefs =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \_ _ fields -> concatMap (exprRefs . rwfType) fields,-        onEnum = const [],-        onUnion = \_ arms -> concatMap (maybe [] exprRefs . rwaPayload) arms-      }--exprRefs :: ResolvedTypeExpr -> [MappedKey]-exprRefs =-  foldTypeExpr-    TypeExprAlgebra-      { onText = [],-        onInt = [],-        onInteger = [],-        onBool = [],-        onNatural = [],-        onTime = [],-        onJson = [],-        onOptional = id,-        onList = id,-        onMap = id,-        onRef = pure-      }--emitMappedCodecs :: HaskellImportPlan -> Agg -> Text-emitMappedCodecs importPlan a = case aTypeGraph a of-  Nothing -> ""-  Just graph ->-    T.intercalate-      "\n\n"-      [ emitStructuralCodec importPlan (aContext a) graph declaration shape-      | ResolvedStructural declaration shape <- codecMappedDeclarations a-      ]--emitStructuralCodec :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text-emitStructuralCodec importPlan ctx graph declaration shape =-  nl-    [ "encode" <> name <> "Mapped :: " <> consumerType <> " -> Value",-      "encode" <> name <> "Mapped = encode" <> name <> "Shape . bindingToShape " <> binding,-      "",-      "parse" <> name <> "Mapped :: Value -> Parser " <> consumerType,-      "parse" <> name <> "Mapped value = bindingFromShape " <> binding <> " <$> parse" <> name <> "Shape value",-      "",-      "decode" <> name <> "Mapped :: Value -> Either Text " <> consumerType,-      "decode" <> name <> "Mapped = mapLeftText . parseEither parse" <> name <> "Mapped",-      "",-      "encode" <> name <> "Shape :: " <> shapeType <> " -> Value",-      emitShapeEncoder importPlan ctx graph declaration shape,-      "",-      "parse" <> name <> "Shape :: Value -> Parser " <> shapeType,-      emitShapeDecoder importPlan ctx graph declaration shape-    ]-  where-    name = sdName declaration-    consumerType = renderReferenceOrDie importPlan (haskellTypeReference (sdHaskell declaration))-    shapeType = renderReferenceOrDie importPlan (qualifiedTypeReference (structuralShapeModule ctx name) (name <> "Shape"))-    binding = renderReferenceOrDie importPlan (qualifiedValueReference (sdBinding declaration))--emitShapeEncoder :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text-emitShapeEncoder importPlan ctx graph declaration =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \_ _ fields ->-          nl $-            ["encode" <> name <> "Shape shape =", "  object"]-              <> objectEntries-                [ tshow (rwfKey field)-                    <> " .= "-                    <> encodeShapeExpr graph (rwfType field) (shapeValue (rwfHaskell field) <> " shape")-                | field <- fields-                ],-        onEnum = \entries ->-          nl $-            ["encode" <> name <> "Shape = \\case"]-              <> ["  " <> shapeConstructor (weCtor entry) <> " -> String " <> tshow (weTag entry) | entry <- entries],-        onUnion = \encoding arms ->-          nl $-            ["encode" <> name <> "Shape = \\case"]-              <> concatMap (unionEncodeArm encoding) arms-      }-  where-    name = sdName declaration-    shapeModuleName = structuralShapeModule ctx name-    shapeConstructor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)-    shapeValue value = renderReferenceOrDie importPlan (HaskellReference shapeModuleName value ValueNamespace RequireQualified)-    unionEncodeArm encoding arm =-      [ "  " <> shapeConstructor (rwaCtor arm) <> payloadPattern <> " ->",-        "    object"-      ]-        <> objectEntries-          ( [tshow (ueTagField encoding) <> " .= (" <> tshow (rwaTag arm) <> " :: Text)"]-              <> [ tshow (ueContentsField encoding) <> " .= " <> encodeShapeExpr graph payload "payload"-                 | payload <- maybeToListText (rwaPayload arm)-                 ]-          )-      where-        payloadPattern = maybe "" (const " payload") (rwaPayload arm)--emitShapeDecoder :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text-emitShapeDecoder importPlan ctx graph declaration =-  foldMappedShape-    MappedShapeAlgebra-      { onRecord = \constructor unknownFields fields ->-          nl $-            [ "parse" <> name <> "Shape = withObject " <> tshow (name <> "Shape") <> " $ \\objectValue -> do"-            ]-              <> rejectLine "  " unknownFields (map rwfKey fields) "objectValue"-              <> [ "  " <> shapeConstructor constructor,-                   "    <$> " <> T.intercalate "\n    <*> " (map (decodeRecordField importPlan ctx graph) fields)-                 ],-        onEnum = \entries ->-          nl $-            [ "parse" <> name <> "Shape = withText " <> tshow (name <> "Shape") <> " $ \\tag -> case tag of"-            ]-              <> ["  " <> tshow (weTag entry) <> " -> pure " <> shapeConstructor (weCtor entry) | entry <- entries]-              <> ["  unknownTag -> " <> renderUnknownFailure (name <> " wire value") "unknownTag" (map weTag entries)],-        onUnion = \encoding arms ->-          nl $-            [ "parse" <> name <> "Shape = withObject " <> tshow (name <> "Shape") <> " $ \\objectValue -> do",-              "  tag <- explicitParseField (withText " <> tshow (name <> " tag") <> " validate" <> name <> "Tag) objectValue " <> tshow (ueTagField encoding),-              "  case tag of"-            ]-              <> concatMap (unionDecodeArm encoding) arms-              <> [ "    _ -> fail \"validated union tag was not handled\"",-                   "",-                   "validate" <> name <> "Tag :: Text -> Parser Text",-                   "validate" <> name <> "Tag tag",-                   "  | tag `elem` " <> renderTextList (map rwaTag arms) <> " = pure tag",-                   "  | otherwise = " <> renderUnknownFailure (name <> " union tag") "tag" (map rwaTag arms)-                 ]-      }-  where-    name = sdName declaration-    shapeModuleName = structuralShapeModule ctx name-    shapeConstructor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)-    rejectLine _ IgnoreUnknown _ _ = []-    rejectLine indent RejectUnknown allowed objectName =-      [indent <> "rejectUnknownFields " <> tshow name <> " " <> renderTextList allowed <> " " <> objectName]-    unionDecodeArm encoding arm =-      ["    " <> tshow (rwaTag arm) <> " -> do"]-        <> rejectLine "      " (ueUnknownFields encoding) allowed "objectValue"-        <> [ case rwaPayload arm of-               Nothing -> "      pure " <> shapeConstructor (rwaCtor arm)-               Just payload ->-                 "      "-                   <> shapeConstructor (rwaCtor arm)-                   <> " <$> explicitParseField ("-                   <> decodeShapeExpr graph payload-                   <> ") objectValue "-                   <> tshow (ueContentsField encoding)-           ]-      where-        allowed = ueTagField encoding : [ueContentsField encoding | rwaPayload arm /= Nothing]--decodeRecordField :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedWireField -> Text-decodeRecordField importPlan ctx graph field = case rwfPresence field of-  PRequired ->-    "explicitParseField (" <> decoder <> ") objectValue " <> key-  POptional ->-    "parseOptionalField ("-      <> missing-      <> ") ("-      <> decoder-      <> ") objectValue "-      <> key-  where-    key = tshow (rwfKey field)-    decoder = decodeShapeExpr graph (rwfType field)-    missing = case rwfOnMissing field of-      Nothing -> "fail " <> tshow ("missing optional field without default: " <> rwfKey field)-      Just onMissing -> "pure " <> renderMissingDefault importPlan ctx graph (rwfType field) onMissing--encodeShapeExpr :: TypeGraph -> ResolvedTypeExpr -> Text -> Text-encodeShapeExpr graph expression =-  renderMappedEncode graph StructuralShapeBoundary (mappedCodecPlanOrDie graph expression)--decodeShapeExpr :: TypeGraph -> ResolvedTypeExpr -> Text-decodeShapeExpr graph expression =-  renderMappedParse graph StructuralShapeBoundary (mappedCodecPlanOrDie graph expression)--mappedCodecPlanOrDie :: TypeGraph -> ResolvedTypeExpr -> MappedCodecPlan-mappedCodecPlanOrDie graph expression =-  either-    (error . ("validated mapped codec plan failed: " <>) . show)-    id-    (planMappedCodec graph expression)--renderMissingDefault :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedTypeExpr -> OnMissing -> Text-renderMissingDefault importPlan ctx graph expression = \case-  OmNull -> "Nothing"-  OmText value -> tshow value-  OmInt value -> T.pack (show value)-  OmBool value -> if value then "True" else "False"-  OmEmptyList -> "[]"-  OmEmptyMap -> "Map.empty"-  OmCtor constructor -> case expression of-    RRef key -> case Map.lookup key (tgDeclarations graph) of-      Just (ResolvedStructural declaration _) -> renderReferenceOrDie importPlan (constructorReference (structuralShapeModule ctx (sdName declaration)) constructor)-      _ -> constructor-    _ -> constructor--objectEntries :: [Text] -> [Text]-objectEntries entries =-  [lead index <> entry | (index, entry) <- zip [(0 :: Int) ..] entries]-    <> ["      ]"]-  where-    lead 0 = "      [ "-    lead _ = "      , "--renderTextList :: [Text] -> Text-renderTextList values = "[" <> T.intercalate ", " (map tshow values) <> "]"---- | Emit a parser failure that names the rejected runtime value and the full,--- deterministic wire set accepted at that point.-renderUnknownFailure :: Text -> Text -> [Text] -> Text-renderUnknownFailure label variable expected =-  "fail ("-    <> tshow ("unknown " <> label <> " ")-    <> " <> show "-    <> variable-    <> " <> "-    <> tshow ("; expected one of: " <> expectedText)-    <> ")"-  where-    expectedText = case expected of-      [] -> "<none>"-      values -> T.intercalate ", " values--renderUnknownEventTypeFailure :: Agg -> Text -> Text-renderUnknownEventTypeFailure aggregate variable =-  "fail ("-    <> tshow "unknown event type "-    <> " <> show "-    <> variable-    <> " <> "-    <> tshow "; expected one of: "-    <> " <> renderExpectedEventTypes "-    <> eventTypesName aggregate-    <> ")"------------------------------------------------------------------------------------- Authoritative version-2 expressions and transducer-----------------------------------------------------------------------------------hasVersion2Ownership :: Agg -> Bool-hasVersion2Ownership = any ((/= LegacyHoleImplementation) . tImplementation) . aTransitions--transitionEntries :: Agg -> [(Int, Transition)]-transitionEntries aggregate =-  [ (layoutDeclarationIndex entry, layoutTransition entry)-  | entry <- transitionLayout (aTransitions aggregate)-  ]--transitionStem :: Int -> Transition -> Text-transitionStem index transition =-  "transition"-    <> tshow' index-    <> pascal (tSource transition)-    <> pascal (tCommand transition)--guardFunctionName :: Int -> Transition -> Text-guardFunctionName index transition = transitionStem index transition <> "Guard"--writeFunctionName :: Int -> Transition -> Name -> Text-writeFunctionName index transition registerName =-  transitionStem index transition <> "Write" <> pascal registerName--holeFunctionName :: Int -> Transition -> Text-holeFunctionName index transition = transitionStem index transition <> "Hole"--holeFoldVersionName :: Int -> Transition -> Text-holeFoldVersionName index transition = holeFunctionName index transition <> "FoldVersion"--outputFunctionName :: Int -> Transition -> Int -> Name -> Text-outputFunctionName transitionIndex transition emitIndex eventName =-  transitionStem transitionIndex transition-    <> "Output"-    <> tshow' emitIndex-    <> pascal eventName---- | Legacy create-once output-hook names made obsolete by authoritative--- version-2 @fields(Command)@ generation.  Scaffolding reports these names as--- safe-to-remove candidates without parsing or modifying consumer Haskell.-obsoleteGeneratedOutputHooks :: Spec -> [(Name, Text)]-obsoleteGeneratedOutputHooks spec = obsoleteGeneratedOutputHooksWith (eventOutputMapping spec) spec--obsoleteGeneratedOutputHooksForService :: CheckedService -> [(Name, Text)]-obsoleteGeneratedOutputHooksForService service =-  obsoleteGeneratedOutputHooksWith-    (eventOutputMappingFromGraphResult (checkedTypeGraph service) spec)-    spec-  where-    spec = checkedSpec service--obsoleteGeneratedOutputHooksWith :: (Aggregate -> Transition -> Int -> Name -> Either EventOutputError EventOutputMapping) -> Spec -> [(Name, Text)]-obsoleteGeneratedOutputHooksWith outputMapping spec =-  [ ( aggName aggregate,-      outputFunctionName transitionIndex transition emitIndex eventName-    )-  | aggregate <- [value | NAggregate value <- specNodes spec],-    entry <- transitionLayout (aggTransitions aggregate),-    let transitionIndex = layoutDeclarationIndex entry-        transition = layoutTransition entry,-    (emitIndex, eventName) <- zip [1 ..] (tEmits transition),-    Right GeneratedCommandIdentity {} <- [outputMapping aggregate transition emitIndex eventName]-  ]--commandForTransition :: Agg -> Transition -> ResolvedCtor-commandForTransition aggregate transition =-  fromMaybe-    (error ("validated aggregate command disappeared: " <> T.unpack (tCommand transition)))-    (find ((== tCommand transition) . rcName) (aCommands aggregate))--eventForName :: Agg -> Name -> ResolvedCtor-eventForName aggregate eventName =-  fromMaybe-    (error ("validated aggregate event disappeared: " <> T.unpack eventName))-    (find ((== eventName) . rcName) (aEvents aggregate))--commandFieldsType :: Transition -> Text-commandFieldsType transition = "RegFieldsOf " <> tCommand transition <> "Data"--payloadProjectionType :: Agg -> Transition -> Text-payloadProjectionType aggregate transition =-  "B.PayloadProj "-    <> aName aggregate-    <> "Regs "-    <> aName aggregate-    <> "Command ("-    <> commandFieldsType transition-    <> ")"--data ResolvedGeneratedTransition = ResolvedGeneratedTransition-  { resolvedTransitionIndex :: !Int,-    resolvedTransitionSource :: !Transition,-    resolvedTransitionGuard :: !(Maybe TypedScalarExpr),-    resolvedTransitionWrites :: ![(Name, TypedScalarExpr)]-  }-  deriving stock (Eq, Show)--data SilentOutcomeKind = RejectedOutcome | NoOpOutcome-  deriving stock (Eq, Show)--data ResolvedSilentOutcome = ResolvedSilentOutcome-  { resolvedSilentLayout :: !TransitionLayoutEntry,-    resolvedSilentKind :: !SilentOutcomeKind,-    resolvedSilentReason :: !TypedScalarExpr-  }-  deriving stock (Eq, Show)---- Resolve each generated-owned transition exactly once. Import analysis,--- projection planning, and Haskell emission all consume this inventory.-resolvedGeneratedTransitions :: Agg -> [ResolvedGeneratedTransition]-resolvedGeneratedTransitions aggregate =-  [ ResolvedGeneratedTransition-      { resolvedTransitionIndex = index,-        resolvedTransitionSource = transition,-        resolvedTransitionGuard = resolvedGuard index transition <$> tGuard transition,-        resolvedTransitionWrites =-          [ (registerName, resolvedWrite index transition registerName expression)-          | (registerName, expression) <- tWrites transition-          ]-      }-  | (index, transition) <- transitionEntries aggregate,-    tImplementation transition == GeneratedImplementation-  ]-  where-    environment transition = expressionEnvironmentWith (aSymbols aggregate) (aTypeGraph aggregate) (aSpec aggregate) (aAggregate aggregate) transition-    resolvedGuard index transition expression =-      expressionOrDie (guardFunctionName index transition) (resolveGuardExpr (environment transition) expression)-    resolvedWrite index transition registerName expression =-      expressionOrDie (writeFunctionName index transition registerName) (resolveWriteExpr (environment transition) registerName expression)--resolvedGeneratedExpressions :: Agg -> [TypedScalarExpr]-resolvedGeneratedExpressions = generatedTransitionExpressions . resolvedGeneratedTransitions--generatedTransitionExpressions :: [ResolvedGeneratedTransition] -> [TypedScalarExpr]-generatedTransitionExpressions = concatMap transitionExpressions-  where-    transitionExpressions resolved =-      maybe [] pure (resolvedTransitionGuard resolved)-        <> map snd (resolvedTransitionWrites resolved)--resolvedSilentOutcomes :: Agg -> [ResolvedSilentOutcome]-resolvedSilentOutcomes aggregate =-  [ ResolvedSilentOutcome-      { resolvedSilentLayout = entry,-        resolvedSilentKind = kind,-        resolvedSilentReason = resolveReason entry expected expression-      }-  | entry <- transitionLayout (aTransitions aggregate),-    let transition = layoutTransition entry,-    tMode transition == TmLive,-    (kind, expected, expression) <- outcomeReason transition-  ]-  where-    outcomeReason transition = case (aDomainOutcomeTypes aggregate, tOutcome transition) of-      (Just outcomeTypes, Just (OutcomeRejected expression _)) ->-        [(RejectedOutcome, resolvedRejectionType outcomeTypes, expression)]-      (Just outcomeTypes, Just (OutcomeNoOp expression _)) ->-        [(NoOpOutcome, resolvedNoOpType outcomeTypes, expression)]-      _ -> []-    resolveReason entry expected expression =-      let transition = layoutTransition entry-          owner = transitionStem (layoutDeclarationIndex entry) transition <> "OutcomeReason"-          environment = expressionEnvironmentWith (aSymbols aggregate) (aTypeGraph aggregate) (aSpec aggregate) (aAggregate aggregate) transition-       in expressionOrDie owner (resolveScalarExpr environment (ExpectScalarType expected) expression)--resolvedOutcomeExpressions :: Agg -> [TypedScalarExpr]-resolvedOutcomeExpressions = map resolvedSilentReason . resolvedSilentOutcomes---- | Guard expressions only.------ A guard renders its operands as @K.Index … SomeType@ annotations and so needs--- each operand type in scope. A write renders @B.slot \@"x" =: d.x@, whose type--- is inferred — importing its source type adds an unused import, which is an--- error under the generated-output @-Werror@. Literals name their type in either--- position and are collected separately.-generatedTransitionGuards :: [ResolvedGeneratedTransition] -> [TypedScalarExpr]-generatedTransitionGuards = concatMap (maybe [] pure . resolvedTransitionGuard)---- | Every literal node in an expression tree.-typedExpressionLiterals :: TypedScalarExpr -> [TypedScalarExpr]-typedExpressionLiterals expression = own <> concatMap typedExpressionLiterals (typedExpressionChildren expression)-  where-    own = case typedScalarNode expression of-      TypedLiteral {} -> [expression]-      _ -> []---- | Types named by literal construction anywhere in an expression.-typedExpressionLiteralTypes :: TypedScalarExpr -> [ResolvedAggregateType]-typedExpressionLiteralTypes expression = own <> concatMap typedExpressionLiteralTypes (typedExpressionChildren expression)-  where-    own = case typedScalarNode expression of-      TypedLiteral {} -> [typedScalarType expression]-      _ -> []--anyTypedExpression :: (TypedScalarExpr -> Bool) -> TypedScalarExpr -> Bool-anyTypedExpression predicate expression =-  predicate expression || any (anyTypedExpression predicate) (typedExpressionChildren expression)--typedExpressionChildren :: TypedScalarExpr -> [TypedScalarExpr]-typedExpressionChildren expression = case typedScalarNode expression of-  TypedLiteral {} -> []-  TypedRoot {} -> []-  TypedProject {} -> []-  TypedAdd _ left right -> [left, right]-  TypedSubtract _ left right -> [left, right]-  TypedMultiply _ left right -> [left, right]-  TypedEqual left right -> [left, right]-  TypedNotEqual left right -> [left, right]-  TypedCompare _ left right -> [left, right]-  TypedAnd left right -> [left, right]-  TypedOr left right -> [left, right]--typedConsumerLiteralNominals :: TypedScalarExpr -> [ResolvedNominalType]-typedConsumerLiteralNominals expression = own <> concatMap typedConsumerLiteralNominals (typedExpressionChildren expression)-  where-    own = case (typedScalarType expression, typedScalarNode expression) of-      (AggregateNominal nominal, TypedLiteral ScalarEnumValue {})-        | ConsumerNominal {} <- resolvedNominalOwnership nominal -> [nominal]-      (AggregateNominal nominal, TypedLiteral ScalarIdValue {})-        | ConsumerNominal {} <- resolvedNominalOwnership nominal -> [nominal]-      _ -> []--typedGeneratedNominals :: TypedScalarExpr -> [ResolvedNominalType]-typedGeneratedNominals expression = own <> concatMap typedGeneratedNominals (typedExpressionChildren expression)-  where-    own = case typedScalarType expression of-      AggregateNominal nominal-        | GeneratedNominal <- resolvedNominalOwnership nominal -> [nominal]-      _ -> []--expressionOrDie :: Text -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr -> TypedScalarExpr-expressionOrDie owner = either (error . (("validated expression disappeared for " <> T.unpack owner <> ": ") <>) . show) id--data ProjectionAliasTarget-  = StructuralProjectionAlias !ScalarRootProvenance !ResolvedScalarProjection-  | NominalProjectionAlias !ResolvedNominalType !ScalarRootProvenance-  deriving stock (Eq, Show)--data ProjectionAlias = ProjectionAlias-  { projectionAliasTarget :: !ProjectionAliasTarget,-    projectionAliasName :: !Text-  }-  deriving stock (Eq, Show)--projectionAliasesForTransition :: ResolvedGeneratedTransition -> [ProjectionAlias]-projectionAliasesForTransition resolved = allocateAliases targets-  where-    expressions =-      maybe [] pure (resolvedTransitionGuard resolved)-        <> map snd (resolvedTransitionWrites resolved)-    targets = nub (concatMap projectionAliasTargets expressions)--projectionAliasTargets :: TypedScalarExpr -> [ProjectionAliasTarget]-projectionAliasTargets expression = own <> comparisonTargets <> concatMap projectionAliasTargets children-  where-    children = typedExpressionChildren expression-    own = case typedScalarNode expression of-      TypedProject provenance projection -> [StructuralProjectionAlias provenance projection]-      _ -> []-    comparisonTargets = case typedScalarNode expression of-      TypedEqual left right -> mapMaybe nominalTarget [left, right]-      TypedNotEqual left right -> mapMaybe nominalTarget [left, right]-      _ -> []-    nominalTarget operand = case (typedScalarType operand, typedScalarNode operand) of-      (AggregateNominal nominal, TypedRoot provenance)-        | nominalComparisonProjection nominal -> Just (NominalProjectionAlias nominal provenance)-      _ -> Nothing--allocateAliases :: [ProjectionAliasTarget] -> [ProjectionAlias]-allocateAliases = snd . foldl allocate (Map.empty, [])-  where-    allocate (counts, aliases) target =-      let base = projectionAliasBase target-          occurrence = Map.findWithDefault 0 base counts + 1-          alias = if occurrence == 1 then base else base <> tshow' occurrence-       in (Map.insert base occurrence counts, aliases <> [ProjectionAlias target alias])--projectionAliasBase :: ProjectionAliasTarget -> Text-projectionAliasBase target = prefix <> pascal rootName <> pathSuffix-  where-    provenance = case target of-      StructuralProjectionAlias value _ -> value-      NominalProjectionAlias _ value -> value-    (prefix, rootName) = case provenance of-      ScalarRegisterRoot name _ -> ("register", name)-      ScalarCommandRoot name _ -> ("command", name)-    pathSuffix = case target of-      NominalProjectionAlias {} -> ""-      StructuralProjectionAlias _ projection ->-        T.concat-          [ normaliseAliasPart (unescapePointer segment)-          | segment <- filter (not . T.null) (T.splitOn "/" (scalarProjectionPointer projection))-          ]--normaliseAliasPart :: Text -> Text-normaliseAliasPart value = case filter (not . T.null) (T.split (not . isAlphaNum) value) of-  [] -> "Field"-  pieces -> T.concat (map pascal pieces)--unescapePointer :: Text -> Text-unescapePointer = T.replace "~0" "~" . T.replace "~1" "/"--projectionAliasFor :: [ProjectionAlias] -> ProjectionAliasTarget -> Text-projectionAliasFor aliases target =-  maybe-    (error ("resolved projection alias disappeared: " <> show target))-    projectionAliasName-    (find ((== target) . projectionAliasTarget) aliases)--data RenderAssociativity = RenderLeft | RenderRight | RenderNonAssociative-  deriving stock (Eq, Show)--data RenderOperandSide = RenderLeftOperand | RenderRightOperand-  deriving stock (Eq, Show)--data RenderedKeikiExpr = RenderedKeikiExpr-  { renderedKeikiText :: !Text,-    renderedKeikiPrecedence :: !Int-  }-  deriving stock (Eq, Show)--renderedAtom :: Text -> RenderedKeikiExpr-renderedAtom value = RenderedKeikiExpr value 10--renderedInfix :: Int -> RenderAssociativity -> Text -> RenderedKeikiExpr -> RenderedKeikiExpr -> RenderedKeikiExpr-renderedInfix precedence associativity operator left right =-  RenderedKeikiExpr-    ( renderInfixChild precedence associativity RenderLeftOperand left-        <> " "-        <> operator-        <> " "-        <> renderInfixChild precedence associativity RenderRightOperand right-    )-    precedence--renderInfixChild :: Int -> RenderAssociativity -> RenderOperandSide -> RenderedKeikiExpr -> Text-renderInfixChild parentPrecedence associativity side child-  | renderedKeikiPrecedence child > parentPrecedence = renderedKeikiText child-  | renderedKeikiPrecedence child < parentPrecedence = parenthesized-  | otherwise = case associativity of-      RenderLeft-        | side == RenderLeftOperand -> renderedKeikiText child-      RenderRight-        | side == RenderRightOperand -> renderedKeikiText child-      _ -> parenthesized-  where-    parenthesized = "(" <> renderedKeikiText child <> ")"--renderKeikiPredicate :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> Text-renderKeikiPredicate importPlan aliases aggregate transition =-  renderedKeikiText . renderPredicate-  where-    renderPredicate expression = case typedScalarNode expression of-      TypedEqual left right -> comparison ".==" left right-      TypedNotEqual left right -> comparison "./=" left right-      TypedCompare operator left right -> comparison (renderComparisonOperator operator) left right-      TypedAnd left right -> boolean 3 RenderRight ".&&" left right-      TypedOr left right -> boolean 2 RenderRight ".||" left right-      _ ->-        renderedInfix-          4-          RenderNonAssociative-          ".=="-          (renderKeikiTerm importPlan aliases aggregate transition expression)-          (renderedAtom "K.lit True")-    comparison operator left right =-      renderedInfix-        4-        RenderNonAssociative-        operator-        (renderComparisonTerm importPlan aliases aggregate transition left)-        (renderComparisonTerm importPlan aliases aggregate transition right)-    boolean precedence associativity operator left right =-      renderedInfix precedence associativity operator (renderPredicate left) (renderPredicate right)--renderComparisonOperator :: CmpOp -> Text-renderComparisonOperator = \case-  OpEq -> ".=="-  OpNeq -> "./="-  OpLt -> ".<"-  OpLe -> ".<="-  OpGt -> ".>"-  OpGe -> ".>="--renderComparisonTerm :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr-renderComparisonTerm importPlan aliases aggregate transition expression = case (typedScalarType expression, typedScalarNode expression) of-  (AggregateNominal nominal, TypedRoot provenance)-    | nominalComparisonProjection nominal ->-        renderedAtom (projectionAliasFor aliases (NominalProjectionAlias nominal provenance))-  (AggregateNominal nominal, TypedLiteral (ScalarEnumValue _ constructor)) ->-    renderedAtom ("K.lit (" <> tshow (enumWireFor nominal constructor) <> " :: Text)")-  (AggregateNominal _, TypedLiteral (ScalarIdValue _ value)) ->-    renderedAtom ("K.lit (" <> tshow value <> " :: Text)")-  _ -> renderKeikiTerm importPlan aliases aggregate transition expression--nominalComparisonProjection :: ResolvedNominalType -> Bool-nominalComparisonProjection nominal = case resolvedNominalRepresentation nominal of-  IdRepresentation {} -> True-  EnumRepresentation {} -> True-  ScalarRepresentation {} -> case resolvedNominalOwnership nominal of-    ConsumerNominal {} -> True-    GeneratedNominal -> False--enumWireFor :: ResolvedNominalType -> Name -> Text-enumWireFor nominal constructor = case resolvedNominalRepresentation nominal of-  EnumRepresentation constructors -> fromMaybe (error "validated enum literal lost its wire spelling") (lookup constructor (NE.toList constructors))-  _ -> error "validated enum literal lost its enum representation"--renderNominalProjectionTerm :: HaskellImportPlan -> Agg -> Transition -> ResolvedNominalType -> ScalarRootProvenance -> Text-renderNominalProjectionTerm importPlan aggregate transition nominal provenance = case provenance of-  ScalarRegisterRoot registerName ownerType ->-    "K.regProj "-      <> projectionQualifier-      <> "."-      <> witness-      <> " (#"-      <> registerName-      <> " :: K.Index "-      <> aName aggregate-      <> "Regs "-      <> renderDomainType importPlan aggregate ownerType-      <> ")"-  ScalarCommandRoot fieldName ownerType ->-    "K.inpProj "-      <> projectionQualifier-      <> "."-      <> witness-      <> " inCtor"-      <> tCommand transition-      <> " (#"-      <> commandFieldSelector aggregate (tCommand transition) fieldName-      <> " :: K.Index ("-      <> commandFieldsType transition-      <> ") "-      <> renderDomainType importPlan aggregate ownerType-      <> ")"-  where-    projectionQualifier = case resolvedNominalOwnership nominal of-      GeneratedNominal -> "GeneratedNominals"-      ConsumerNominal {} -> "NominalProjections"-    witness = case resolvedNominalRepresentation nominal of-      ScalarRepresentation {} -> lowerFirst (resolvedNominalName nominal) <> "Witness"-      IdRepresentation {} -> nominalEqualityWitnessName nominal-      EnumRepresentation {} -> nominalEqualityWitnessName nominal--renderKeikiTerm :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr-renderKeikiTerm importPlan aliases aggregate transition expression = case typedScalarNode expression of-  TypedLiteral value -> renderedAtom (renderKeikiLiteral importPlan aggregate (typedScalarType expression) value)-  TypedRoot (ScalarRegisterRoot registerName _) -> renderedAtom ("B.reg @" <> tshow registerName)-  TypedRoot (ScalarCommandRoot fieldName _) ->-    renderedAtom ("d." <> commandFieldSelector aggregate (tCommand transition) fieldName)-  TypedProject provenance projection ->-    renderedAtom (projectionAliasFor aliases (StructuralProjectionAlias provenance projection))-  TypedAdd _ left right -> arithmetic 6 ".+" left right-  TypedSubtract _ left right -> arithmetic 6 ".-" left right-  TypedMultiply _ left right -> arithmetic 7 ".*" left right-  TypedEqual {} -> impossiblePredicate-  TypedNotEqual {} -> impossiblePredicate-  TypedCompare {} -> impossiblePredicate-  TypedAnd {} -> impossiblePredicate-  TypedOr {} -> impossiblePredicate-  where-    arithmetic precedence operator left right =-      renderedInfix-        precedence-        RenderLeft-        operator-        (renderKeikiTerm importPlan aliases aggregate transition left)-        (renderKeikiTerm importPlan aliases aggregate transition right)-    impossiblePredicate = error "predicate-valued Boolean expressions cannot be lowered as register terms"--renderOutcomeReasonEvaluation :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> Text-renderOutcomeReasonEvaluation importPlan aggregate transition expression =-  evaluator-    <> " ("-    <> renderedKeikiText rendered-    <> ") registers command"-  where-    (evaluator, rendered) = case typedScalarNode expression of-      TypedEqual {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)-      TypedNotEqual {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)-      TypedCompare {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)-      TypedAnd {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)-      TypedOr {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)-      _ -> ("K.evalTerm", renderOutcomeKeikiTerm importPlan aggregate transition expression)--renderOutcomePredicate :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr-renderOutcomePredicate importPlan aggregate transition = renderPredicate-  where-    renderPredicate expression = case typedScalarNode expression of-      TypedEqual left right -> comparison ".==" left right-      TypedNotEqual left right -> comparison "./=" left right-      TypedCompare operator left right -> comparison (renderComparisonOperator operator) left right-      TypedAnd left right -> boolean 3 RenderRight ".&&" left right-      TypedOr left right -> boolean 2 RenderRight ".||" left right-      _ ->-        renderedInfix-          4-          RenderNonAssociative-          ".=="-          (renderOutcomeKeikiTerm importPlan aggregate transition expression)-          (renderedAtom "K.lit True")-    comparison operator left right =-      renderedInfix-        4-        RenderNonAssociative-        operator-        (renderOutcomeComparisonTerm importPlan aggregate transition left)-        (renderOutcomeComparisonTerm importPlan aggregate transition right)-    boolean precedence associativity operator left right =-      renderedInfix precedence associativity operator (renderPredicate left) (renderPredicate right)--renderOutcomeComparisonTerm :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr-renderOutcomeComparisonTerm importPlan aggregate transition expression = case (typedScalarType expression, typedScalarNode expression) of-  (AggregateNominal nominal, TypedRoot provenance)-    | nominalComparisonProjection nominal ->-        renderedAtom (renderNominalProjectionTerm importPlan aggregate transition nominal provenance)-  (AggregateNominal nominal, TypedLiteral (ScalarEnumValue _ constructor)) ->-    renderedAtom ("K.lit (" <> tshow (enumWireFor nominal constructor) <> " :: Text)")-  (AggregateNominal _, TypedLiteral (ScalarIdValue _ value)) ->-    renderedAtom ("K.lit (" <> tshow value <> " :: Text)")-  _ -> renderOutcomeKeikiTerm importPlan aggregate transition expression--renderOutcomeKeikiTerm :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr-renderOutcomeKeikiTerm importPlan aggregate transition expression = case typedScalarNode expression of-  TypedLiteral value -> renderedAtom (renderKeikiLiteral importPlan aggregate (typedScalarType expression) value)-  TypedRoot (ScalarRegisterRoot registerName _) -> renderedAtom ("B.reg @" <> tshow registerName)-  TypedRoot (ScalarCommandRoot fieldName ownerType) ->-    renderedAtom-      ( "K.inpCtor inCtor"-          <> tCommand transition-          <> " (#"-          <> commandFieldSelector aggregate (tCommand transition) fieldName-          <> " :: K.Index ("-          <> commandFieldsType transition-          <> ") "-          <> renderDomainType importPlan aggregate ownerType-          <> ")"-      )-  TypedProject provenance projection ->-    renderedAtom (renderStructuralProjectionTerm importPlan aggregate transition provenance projection)-  TypedAdd _ left right -> arithmetic 6 ".+" left right-  TypedSubtract _ left right -> arithmetic 6 ".-" left right-  TypedMultiply _ left right -> arithmetic 7 ".*" left right-  TypedEqual {} -> impossiblePredicate-  TypedNotEqual {} -> impossiblePredicate-  TypedCompare {} -> impossiblePredicate-  TypedAnd {} -> impossiblePredicate-  TypedOr {} -> impossiblePredicate-  where-    arithmetic precedence operator left right =-      renderedInfix-        precedence-        RenderLeft-        operator-        (renderOutcomeKeikiTerm importPlan aggregate transition left)-        (renderOutcomeKeikiTerm importPlan aggregate transition right)-    impossiblePredicate = error "predicate-valued Boolean outcome cannot be lowered as a Keiki term"--renderStructuralProjectionTerm :: HaskellImportPlan -> Agg -> Transition -> ScalarRootProvenance -> ResolvedScalarProjection -> Text-renderStructuralProjectionTerm importPlan aggregate transition provenance projection = case provenance of-  ScalarRegisterRoot registerName ownerType ->-    "K.regProj StructuralProjections."-      <> witness-      <> " (#"-      <> registerName-      <> " :: K.Index "-      <> aName aggregate-      <> "Regs "-      <> renderDomainType importPlan aggregate ownerType-      <> ")"-  ScalarCommandRoot fieldName ownerType ->-    "K.inpProj StructuralProjections."-      <> witness-      <> " inCtor"-      <> tCommand transition-      <> " (#"-      <> commandFieldSelector aggregate (tCommand transition) fieldName-      <> " :: K.Index ("-      <> commandFieldsType transition-      <> ") "-      <> renderDomainType importPlan aggregate ownerType-      <> ")"-  where-    witness =-      fromMaybe-        (error ("resolved structural projection witness disappeared: " <> show projection))-        (aTypeGraph aggregate >>= \graph -> projectionWitnessName graph (scalarProjectionOwner projection) (scalarProjectionPointer projection))--renderKeikiLiteral :: HaskellImportPlan -> Agg -> ResolvedAggregateType -> ScalarValue -> Text-renderKeikiLiteral importPlan aggregate scalarType = \case-  ScalarTextValue value -> "K.lit (" <> tshow value <> " :: Text)"-  ScalarIntValue value -> "K.lit (" <> tshow' value <> " :: Int)"-  ScalarIntegerValue value -> "K.lit (" <> T.pack (show value) <> " :: Integer)"-  ScalarNaturalValue value -> "K.lit (" <> T.pack (show value) <> " :: Natural)"-  ScalarBoolValue value -> "K.lit " <> if value then "True" else "False"-  ScalarTimeValue value -> "K.lit " <> renderRegisterInitial (InitialTime value)-  ScalarEnumValue _typeName constructor -> case scalarType of-    AggregateNominal nominal -> case resolvedNominalOwnership nominal of-      GeneratedNominal -> "K.lit " <> constructor-      ConsumerNominal binding ->-        "K.lit (nominalFromRepresentation "-          <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding))-          <> " "-          <> renderReferenceOrDie importPlan (nominalRepresentationConstructorReference (aContext aggregate) nominal constructor)-          <> ")"-    _ -> error "validated enum literal lost its nominal type"-  ScalarIdValue typeName value -> case scalarType of-    AggregateNominal nominal -> case resolvedNominalOwnership nominal of-      GeneratedNominal -> case idDomainContractFor (aLanguageContract aggregate) =<< idPrefixOf nominal of-        Nothing -> "K.lit (" <> typeName <> " " <> tshow value <> ")"-        Just _ ->-          "K.lit (case parse"-            <> typeName-            <> " "-            <> tshow value-            <> " of Right parsed -> parsed; Left _ -> error \"validated ID literal failed to parse\")"-      ConsumerNominal binding -> case resolvedNominalRepresentation nominal of-        IdRepresentation prefix ->-          "K.lit (nominalFromRepresentation "-            <> renderReferenceOrDie importPlan (qualifiedValueReference (consumerNominalBinding binding))-            <> " (case KindID.parseText @"-            <> tshow prefix-            <> " "-            <> tshow value-            <> " of Right parsed -> parsed; Left _ -> error \"validated ID literal failed to parse\"))"-        _ -> error "validated ID literal lost its ID representation"-    _ -> error "validated ID literal lost its nominal type"-  where-    idPrefixOf nominal = case resolvedNominalRepresentation nominal of-      IdRepresentation prefix -> Just prefix-      _ -> Nothing--generatedIdSampleHaskell :: Agg -> ResolvedNominalType -> Maybe Text-generatedIdSampleHaskell aggregate nominal = do-  prefix <- case resolvedNominalRepresentation nominal of-    IdRepresentation value -> Just value-    _ -> Nothing-  contract <- idDomainContractFor (aLanguageContract aggregate) prefix-  let name = resolvedNominalName nominal-      sample = idDomainSampleText contract-  pure-    ( "(case parse"-        <> name-        <> " "-        <> tshow sample-        <> " of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\")"-    )--emitGeneratedTransducer :: Agg -> Text-emitGeneratedTransducer aggregate =-  nl $-    renderGeneratedLanguagePragmas-      ( [ExtBlockArguments, ExtQualifiedDo]-          <> [ExtOverloadedLabels | not (null projectionAliases)]-          <> [ExtOverloadedRecordDot | transducerUsesRecordDot aggregate]-      )-      ++ [ generatedBanner,-           "module " <> aGenPrefix aggregate <> ".Transducer",-           "  ( " <> lowerFirst (aName aggregate) <> "Transducer",-           "  , " <> lowerFirst (aName aggregate) <> "FoldFingerprint",-           "  , BehaviorOwnership (..)",-           "  , " <> lowerFirst (aName aggregate) <> "PredicateVerifications",-           "  ) where",-           "",-           "import " <> aGenPrefix aggregate <> ".Domain",-           "import Data.Text (Text)"-         ]-      ++ ["import Data.Time.Calendar (fromGregorian)" | expressionUsesTimeLiteral]-      ++ ["import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)" | expressionUsesTimeLiteral]-      ++ ["import Numeric.Natural (Natural)" | expressionUsesNaturalLiteral]-      ++ generatedNominalTypeImportsWithParsers-        (aggregateCheckedService aggregate)-        (aContext aggregate)-        generatedExpressionNominals-        generatedLiteralNominals-      ++ structuralProjectionImport-      ++ generatedNominalProjectionImport-      ++ consumerNominalProjectionImport-      ++ consumerImports-      ++ ["import Data.KindID qualified as KindID" | expressionUsesConsumerIdLiteral]-      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation)" | expressionUsesConsumerNominalLiteral]-      ++ [ "import Keiki.Builder qualified as B",-           "import Keiki.Core (" <> T.intercalate ", " keikiCoreImports <> ")",-           "import Keiki.Core qualified as K",-           "import Keiki.Symbolic qualified as S"-         ]-      ++ ["import " <> aHolePrefix aggregate <> ".Holes qualified as Holes" | transducerUsesHoles aggregate]-      ++ ["import Data.Text qualified as T" | anyHoleOwned aggregate]-      ++ ["import Keiki.Builder ((=:))" | any (not . null . tWrites . snd) (transitionEntries aggregate)]-      ++ ["import Keiki.Generics (RegFieldsOf)" | not (null projectionAliases)]-      ++ ["import Keiro.Snapshot.Codec (FoldVersion (..))" | anyHoleOwned aggregate]-      ++ [ "",-           lowerFirst (aName aggregate) <> "Transducer",-           "  :: SymTransducer",-           "       (HsPred " <> aName aggregate <> "Regs " <> aName aggregate <> "Command)",-           "       " <> aName aggregate <> "Regs",-           "       " <> aVertexType aggregate,-           "       " <> aName aggregate <> "Command",-           "       " <> aName aggregate <> "Event",-           lowerFirst (aName aggregate) <> "Transducer =",-           "  B.buildTransducer " <> initialVertex aggregate <> " initial" <> aName aggregate <> "Regs isTerminal do",-           nl (concatMap (generatedFromBlock importPlan aggregate resolvedTransitions) (groupTransitionEntriesBySource aggregate)),-           " where",-           "  isTerminal = \\case",-           nl ["    " <> vertexCtor aggregate (stName state) <> " -> True" | state <- aStates aggregate, stTerminal state],-           "    _ -> False",-           "",-           lowerFirst (aName aggregate) <> "FoldFingerprint :: Text",-           lowerFirst (aName aggregate) <> "FoldFingerprint = " <> foldFingerprintExpression aggregate,-           "",-           "data BehaviorOwnership = GeneratedOwned | HoleOwned",-           "  deriving stock (Eq, Show)",-           "",-           "-- Every checked transition predicate is audited through Keiki's conservative",-           "-- symbolic verifier. Opaque Hole terms remain explicitly unverified.",-           lowerFirst (aName aggregate) <> "PredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]",-           lowerFirst (aName aggregate) <> "PredicateVerifications = sequence",-           nl (renderVerificationList aggregate),-           " where",-           "  verifyTransition label owner source edgeIndex =",-           "    case drop edgeIndex (K.edgesOut " <> lowerFirst (aName aggregate) <> "Transducer source) of",-           "      K.Edge predicate _ _ _ _ : _ -> (\\result -> (label, owner, result)) <$> S.verifyPredicate predicate",-           "      [] -> pure (label, owner, S.UnverifiedSolverFailure \"generated transition edge missing\")"-         ]-  where-    resolvedTransitions = resolvedGeneratedTransitions aggregate-    resolvedExpressions = generatedTransitionExpressions resolvedTransitions-    projectionAliases = concatMap projectionAliasesForTransition resolvedTransitions-    projectionTargets = map projectionAliasTarget projectionAliases-    structuralProjectionImport =-      [ "import " <> structuralProjectionModule (aContext aggregate) <> " qualified as StructuralProjections"-      | any isStructuralProjection projectionTargets-      ]-    generatedNominalProjectionImport =-      [ "import " <> generatedNominalModule (aContext aggregate) <> " qualified as GeneratedNominals"-      | any isGeneratedNominalProjection projectionTargets-      ]-    consumerNominalProjectionImport =-      [ "import " <> nominalProjectionModule (aContext aggregate) <> " qualified as NominalProjections"-      | any isConsumerNominalProjection projectionTargets-      ]-    consumerImports =-      T.lines (renderPlannedImports importPlan)-    expressionImportTypes =-      nub-        ( concatMap typedExpressionImportTypes (generatedTransitionGuards resolvedTransitions)-            <> concatMap typedExpressionLiteralTypes resolvedExpressions-        )-    consumerLiteralNominals = nub [nominal | expression <- resolvedExpressions, nominal <- typedConsumerLiteralNominals expression]-    importPlan = transducerImportPlan aggregate expressionImportTypes consumerLiteralNominals-    generatedExpressionNominals =-      stableNominals-        [ nominal-        | expression <- resolvedExpressions,-          nominal <- typedGeneratedNominals expression-        ]-    -- Only a literal names `parse<Id>`; see 'generatedNominalTypeImportsWithParsers'.-    generatedLiteralNominals =-      stableNominals-        [ nominal-        | expression <- resolvedExpressions,-          literal <- typedExpressionLiterals expression,-          nominal <- typedGeneratedNominals literal-        ]-    expressionUsesTimeLiteral = any (anyTypedExpression isTimeLiteral) resolvedExpressions-    expressionUsesNaturalLiteral = any (anyTypedExpression isNaturalLiteral) resolvedExpressions-    expressionUsesConsumerNominalLiteral = not (null consumerLiteralNominals)-    expressionUsesConsumerIdLiteral = any (isIdRepresentation . resolvedNominalRepresentation) consumerLiteralNominals-    usedOperators = nub (concatMap generatedTransitionOperators resolvedTransitions)-    keikiCoreImports = ["HsPred", "SymTransducer"] <> ["(" <> operator <> ")" | operator <- expressionOperatorOrder, operator `elem` usedOperators]-    isTimeLiteral expression = case typedScalarNode expression of-      TypedLiteral ScalarTimeValue {} -> True-      _ -> False-    isNaturalLiteral expression = case typedScalarNode expression of-      TypedLiteral ScalarNaturalValue {} -> True-      _ -> False-    isIdRepresentation IdRepresentation {} = True-    isIdRepresentation _ = False--transducerUsesRecordDot :: Agg -> Bool-transducerUsesRecordDot aggregate =-  any expressionUsesCommandRoot (resolvedGeneratedExpressions aggregate)-    || any generatedOutputUsesCommandField generatedOutputs-  where-    generatedOutputs =-      [ outputMappingFor aggregate transitionIndex emitIndex-      | (transitionIndex, transition) <- transitionEntries aggregate,-        tImplementation transition == GeneratedImplementation,-        emitIndex <- [1 .. length (tEmits transition)]-      ]-    generatedOutputUsesCommandField (GeneratedCommandIdentity _ fields) = not (null fields)-    generatedOutputUsesCommandField HandOwnedEventOutput {} = False-    expressionUsesCommandRoot = anyTypedExpression isCommandRoot-    isCommandRoot expression = case typedScalarNode expression of-      TypedRoot ScalarCommandRoot {} -> True-      _ -> False--transducerImportPlan :: Agg -> [ResolvedAggregateType] -> [ResolvedNominalType] -> HaskellImportPlan-transducerImportPlan aggregate importedTypes literalNominals =-  planImportsOrDie-    (aGenPrefix aggregate <> ".Transducer")-    (Set.fromList [aName aggregate <> "Regs", aName aggregate <> "Command", aName aggregate <> "Event"])-    ( Set.unions-        [ aggregateSourceReferences (aggregateConsumerHaskellSource (aSymbols aggregate) resolvedType)-        | resolvedType <- importedTypes-        ]-        <> Set.fromList-          [ reference-          | nominal <- literalNominals,-            ConsumerNominal binding <- [resolvedNominalOwnership nominal],-            reference <--              qualifiedValueReference (consumerNominalBinding binding)-                : case resolvedNominalRepresentation nominal of-                  EnumRepresentation constructors ->-                    [ nominalRepresentationConstructorReference (aContext aggregate) nominal constructor-                    | (constructor, _) <- NE.toList constructors-                    ]-                  _ -> []-          ]-    )--typedExpressionImportTypes :: TypedScalarExpr -> [ResolvedAggregateType]-typedExpressionImportTypes expression = own <> concatMap typedExpressionImportTypes (typedExpressionChildren expression)-  where-    own = case typedScalarNode expression of-      TypedLiteral {} -> [typedScalarType expression]-      TypedRoot provenance -> [scalarRootType provenance]-      TypedProject provenance _ -> [scalarRootType provenance]-      _ -> []--scalarRootType :: ScalarRootProvenance -> ResolvedAggregateType-scalarRootType = \case-  ScalarRegisterRoot _ resolvedType -> resolvedType-  ScalarCommandRoot _ resolvedType -> resolvedType--isStructuralProjection :: ProjectionAliasTarget -> Bool-isStructuralProjection StructuralProjectionAlias {} = True-isStructuralProjection NominalProjectionAlias {} = False--isGeneratedNominalProjection :: ProjectionAliasTarget -> Bool-isGeneratedNominalProjection (NominalProjectionAlias nominal _) = resolvedNominalOwnership nominal == GeneratedNominal-isGeneratedNominalProjection StructuralProjectionAlias {} = False--isConsumerNominalProjection :: ProjectionAliasTarget -> Bool-isConsumerNominalProjection (NominalProjectionAlias nominal _) = case resolvedNominalOwnership nominal of-  ConsumerNominal {} -> True-  GeneratedNominal -> False-isConsumerNominalProjection StructuralProjectionAlias {} = False--expressionOperatorOrder :: [Text]-expressionOperatorOrder = [".*", ".+", ".-", ".==", "./=", ".<", ".<=", ".>", ".>=", ".&&", ".||"]--generatedTransitionOperators :: ResolvedGeneratedTransition -> [Text]-generatedTransitionOperators resolved =-  maybe [] expressionPredicateOperators (resolvedTransitionGuard resolved)-    <> concatMap (expressionTermOperators . snd) (resolvedTransitionWrites resolved)--outcomeExpressionOperators :: TypedScalarExpr -> [Text]-outcomeExpressionOperators expression = case typedScalarNode expression of-  TypedEqual {} -> expressionPredicateOperators expression-  TypedNotEqual {} -> expressionPredicateOperators expression-  TypedCompare {} -> expressionPredicateOperators expression-  TypedAnd {} -> expressionPredicateOperators expression-  TypedOr {} -> expressionPredicateOperators expression-  _ -> expressionTermOperators expression--expressionPredicateOperators :: TypedScalarExpr -> [Text]-expressionPredicateOperators expression = case typedScalarNode expression of-  TypedEqual left right -> ".==" : expressionTermOperators left <> expressionTermOperators right-  TypedNotEqual left right -> "./=" : expressionTermOperators left <> expressionTermOperators right-  TypedCompare operator left right -> renderComparisonOperator operator : expressionTermOperators left <> expressionTermOperators right-  TypedAnd left right -> ".&&" : expressionPredicateOperators left <> expressionPredicateOperators right-  TypedOr left right -> ".||" : expressionPredicateOperators left <> expressionPredicateOperators right-  _ -> ".==" : expressionTermOperators expression--expressionTermOperators :: TypedScalarExpr -> [Text]-expressionTermOperators expression = case typedScalarNode expression of-  TypedAdd _ left right -> ".+" : expressionTermOperators left <> expressionTermOperators right-  TypedSubtract _ left right -> ".-" : expressionTermOperators left <> expressionTermOperators right-  TypedMultiply _ left right -> ".*" : expressionTermOperators left <> expressionTermOperators right-  _ -> concatMap expressionTermOperators (typedExpressionChildren expression)--anyHoleOwned :: Agg -> Bool-anyHoleOwned = any ((== HoleImplementation) . tImplementation) . aTransitions--transducerUsesHoles :: Agg -> Bool-transducerUsesHoles aggregate =-  anyHoleOwned aggregate-    || any isHandOwned (Map.elems (aOutputMappings aggregate))-  where-    isHandOwned HandOwnedEventOutput {} = True-    isHandOwned GeneratedCommandIdentity {} = False--renderVerificationList :: Agg -> [Text]-renderVerificationList aggregate =-  [ (if listIndex == (0 :: Int) then "  [ " else "  , ")-      <> "verifyTransition "-      <> tshow (transitionStem transitionIndex transition)-      <> " "-      <> ownership-      <> " "-      <> vertexCtor aggregate source-      <> " "-      <> tshow' edgeIndex-  | (listIndex, (source, edgeIndex, transitionIndex, transition)) <- zip [0 ..] entries,-    let ownership = case tImplementation transition of-          GeneratedImplementation -> "GeneratedOwned"-          HoleImplementation -> "HoleOwned"-          LegacyHoleImplementation -> error "legacy transition reached version-2 verification generation"-  ]-    <> ["  ]"]-  where-    entries =-      [ (source, edgeIndex, transitionIndex, transition)-      | (source, transitions) <- groupTransitionLayoutBySource (transitionLayout (aTransitions aggregate)),-        entry <- transitions,-        let edgeIndex = layoutOutgoingIndex entry-            transitionIndex = layoutDeclarationIndex entry-            transition = layoutTransition entry-      ]--foldFingerprintExpression :: Agg -> Text-foldFingerprintExpression aggregate = case holeVersions of-  [] -> tshow (aFoldFingerprint aggregate)-  _ ->-    "T.intercalate \"|\" ("-      <> tshow (aFoldFingerprint aggregate)-      <> " : [foldToken "-      <> T.intercalate ", foldToken " holeVersions-      <> "] ) where foldToken (FoldVersion token) = T.pack (show (T.length token)) <> \":\" <> token"-  where-    holeVersions =-      [ "Holes." <> holeFoldVersionName index transition-      | (index, transition) <- transitionEntries aggregate,-        tImplementation transition == HoleImplementation-      ]--groupTransitionEntriesBySource :: Agg -> [(Text, [(Int, Transition)])]-groupTransitionEntriesBySource aggregate =-  [ ( source,-      [(layoutDeclarationIndex entry, layoutTransition entry) | entry <- entries]-    )-  | (source, entries) <- groupTransitionLayoutBySource (transitionLayout (aTransitions aggregate))-  ]--generatedFromBlock :: HaskellImportPlan -> Agg -> [ResolvedGeneratedTransition] -> (Text, [(Int, Transition)]) -> [Text]-generatedFromBlock importPlan aggregate resolvedTransitions (source, transitions) =-  ["    B.from " <> vertexCtor aggregate source <> " do"]-    ++ concatMap (uncurry (generatedOnCmdBlock importPlan aggregate resolvedTransitions)) transitions--generatedOnCmdBlock :: HaskellImportPlan -> Agg -> [ResolvedGeneratedTransition] -> Int -> Transition -> [Text]-generatedOnCmdBlock importPlan aggregate resolvedTransitions index transition =-  ["      B.onCmd inCtor" <> tCommand transition <> " $ \\" <> payloadBinder <> " -> B.do"]-    ++ projectionBindingLines-    ++ ["        B.replayOnly" | tMode transition == TmReplayOnly]-    ++ generatedBehavior-    ++ outputLines-    ++ ["        B.noEmit" | null (tEmits transition)]-    ++ ["        B.goto " <> vertexCtor aggregate (tGoto transition)]-  where-    generatedBehavior = case tImplementation transition of-      GeneratedImplementation ->-        maybe [] (renderGuardLines importPlan aliases aggregate transition) (resolvedTransitionGuard resolved)-          ++ [ "        B.slot @" <> tshow registerName <> " =: " <> renderAssignmentOperand (renderKeikiTerm importPlan aliases aggregate transition expression)-             | (registerName, expression) <- resolvedTransitionWrites resolved-             ]-      HoleImplementation -> ["        Holes." <> holeFunctionName index transition <> " d"]-      LegacyHoleImplementation -> error "legacy transition reached version-2 transducer generation"-    resolved =-      fromMaybe-        (error ("resolved generated transition disappeared: " <> show index))-        (find ((== index) . resolvedTransitionIndex) resolvedTransitions)-    aliases-      | tImplementation transition == GeneratedImplementation = projectionAliasesForTransition resolved-      | otherwise = []-    projectionBindingLines = case aliases of-      [] -> []-      firstAlias : remainingAliases ->-        ["        let " <> renderProjectionAliasBinding importPlan aggregate transition firstAlias]-          <> ["            " <> renderProjectionAliasBinding importPlan aggregate transition alias | alias <- remainingAliases]-    outputLines =-      concat-        [ generatedOutputLines aggregate index transition emitIndex eventName-        | (emitIndex, eventName) <- zip [1 ..] (tEmits transition)-        ]-    payloadBinder-      | payloadIsUsed = "d"-      | otherwise = "_d"-    payloadIsUsed = case tImplementation transition of-      GeneratedImplementation ->-        isJust (resolvedTransitionGuard resolved)-          || not (null (resolvedTransitionWrites resolved))-          || any outputUsesPayload (zip [1 ..] (tEmits transition))-      HoleImplementation -> True-      LegacyHoleImplementation -> True-    outputUsesPayload (emitIndex, _) = case outputMappingFor aggregate index emitIndex of-      GeneratedCommandIdentity _ fields -> not (null fields)-      HandOwnedEventOutput {} -> True--renderProjectionAliasBinding :: HaskellImportPlan -> Agg -> Transition -> ProjectionAlias -> Text-renderProjectionAliasBinding importPlan aggregate transition alias =-  projectionAliasName alias <> " = " <> case projectionAliasTarget alias of-    StructuralProjectionAlias provenance projection -> renderStructuralProjectionTerm importPlan aggregate transition provenance projection-    NominalProjectionAlias nominal provenance -> renderNominalProjectionTerm importPlan aggregate transition nominal provenance--renderGuardLines :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> [Text]-renderGuardLines importPlan aliases aggregate transition expression =-  ["        B.requireGuard $"]-    <> ["          " <> line | line <- T.lines readable]-  where-    readable =-      T.replace " .|| " "\n.|| "-        . T.replace " .&& " "\n.&& "-        $ renderKeikiPredicate importPlan aliases aggregate transition expression--renderAssignmentOperand :: RenderedKeikiExpr -> Text-renderAssignmentOperand expression-  | renderedKeikiPrecedence expression <= 6 = "(" <> renderedKeikiText expression <> ")"-  | otherwise = renderedKeikiText expression--generatedOutputLines :: Agg -> Int -> Transition -> Int -> Name -> [Text]-generatedOutputLines aggregate transitionIndex transition emitIndex eventName =-  case outputMappingFor aggregate transitionIndex emitIndex of-    GeneratedCommandIdentity sourceCommand fields -> case fields of-      [] -> ["        B.emit wire" <> eventName <> " B.oNil"]-      _ ->-        [ "        B.emit wire" <> eventName <> " (" <> eventName <> "TermFields"-        ]-          <> [ lead fieldIndex-                 <> resolvedSelector sourceCommand field-                 <> " = d."-                 <> resolvedSelector sourceCommand field-             | (fieldIndex, field) <- zip [0 :: Int ..] fields-             ]-          <> ["          })"]-    HandOwnedEventOutput {} ->-      [ "        B.emit wire"-          <> eventName-          <> " (Holes."-          <> outputFunctionName transitionIndex transition emitIndex eventName-          <> " d)"-      ]-  where-    lead 0 = "          { "-    lead _ = "          , "-    resolvedSelector sourceCommand copiedField =-      commandFieldSelector aggregate sourceCommand (outputSelector copiedField)--commandFieldSelector :: Agg -> Name -> Name -> Text-commandFieldSelector aggregate commandName dslFieldName =-  case [ fieldSelector identity-       | command <- aCommands aggregate,-         rcName command == commandName,-         (identity, _) <- rcFields command,-         fieldDslName identity == dslFieldName-       ] of-    selector : _ -> selector-    [] -> error "validated generated command-field selector was not found"--outputMappingFor :: Agg -> Int -> Int -> EventOutputMapping-outputMappingFor aggregate transitionIndex emitIndex =-  fromMaybe-    (error ("missing checked event-output mapping for transition " <> show transitionIndex <> ", emit " <> show emitIndex))-    (Map.lookup (transitionIndex, emitIndex) (aOutputMappings aggregate))------------------------------------------------------------------------------------- EventStream module-----------------------------------------------------------------------------------emitEventStream :: Agg -> Text-emitEventStream a =-  nl $-    renderGeneratedLanguagePragmas [ExtOverloadedLabels | outcomeUsesLabels]-      ++ [ generatedBanner,-           "module " <> aGenPrefix a <> ".EventStream",-           "  ( " <> lowerFirst (aName a) <> "Category",-           "  , " <> lowerFirst (aName a) <> "CommandCategory",-           "  , " <> lowerFirst (aName a) <> "EventStream",-           "  , " <> lowerFirst (aName a) <> "EventStreamDef",-           "  , " <> aName a <> "EventStream",-           "  , " <> aName a <> "EventStreamDef"-         ]-      ++ ["  , " <> lowerFirst (aName a) <> "SnapshotFixture" | hasSnapshot a]-      ++ ["  , " <> lowerFirst (aName a) <> "DomainCommandHandler" | outcomeEnabled]-      ++ [ "  ) where",-           "",-           "import " <> aGenPrefix a <> ".Domain",-           "import " <> aGenPrefix a <> ".Codec (" <> lowerFirst (aName a) <> "Codec)",-           transducerImport a-         ]-      ++ generatedOutcomeNominalImports-      ++ structuralProjectionImports-      ++ generatedNominalProjectionImports-      ++ consumerNominalProjectionImports-      ++ consumerImports-      ++ ["import Data.KindID qualified as KindID" | outcomeUsesConsumerIdLiteral]-      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation)" | outcomeUsesConsumerNominalLiteral]-      ++ ["import Keiki.Builder qualified as B" | outcomeUsesRegisterRoot]-      ++ [keikiCoreImport]-      ++ ["import Keiki.Core qualified as K" | outcomeEnabled]-      ++ ["import Keiki.Generics (RegFieldsOf)" | outcomeUsesCommandRoot]-      ++ ["import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))" | outcomeEnabled]-      ++ [ "import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))",-           "import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)"-         ]-      ++ ["import Data.Text (Text)" | hasSnapshot a || outcomeUsesText]-      ++ ["import Data.Time.Calendar (fromGregorian)" | outcomeUsesTimeLiteral]-      ++ ["import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)" | outcomeUsesTimeLiteral]-      ++ ["import Data.Time.Clock (UTCTime)" | outcomeUsesTimeType && not outcomeUsesTimeLiteral]-      ++ ["import Numeric.Natural (Natural)" | outcomeUsesNaturalType]-      ++ ["import Keiro.Snapshot.Codec (defaultStateCodec, withFoldFingerprint)" | hasSnapshot a]-      ++ [ "import Keiro.Stream qualified as Stream",-           "",-           "-- The validated aggregate stream category (hole-kind 5: referenced, never retyped).",-           "-- Entity streams are '<category>-<id>' via Keiro.Stream.entityStream.",-           "-- categoryUnsafe is safe here because this generated literal passed the DSL category proof.",-           lowerFirst (aName a) <> "Category :: Stream.StreamCategory " <> aName a <> "EventStreamDef",-           lowerFirst (aName a) <> "Category = Stream.categoryUnsafe " <> tshow categoryName,-           "",-           "-- The same category text, typed for command envelopes such as PMCommand.",-           lowerFirst (aName a) <> "CommandCategory :: Stream.StreamCategory " <> aName a <> "Command",-           lowerFirst (aName a) <> "CommandCategory = Stream.categoryUnsafe " <> tshow categoryName,-           "",-           "type " <> aName a <> "EventStreamDef =",-           "  EventStream (HsPred " <> aName a <> "Regs " <> aName a <> "Command) " <> aName a <> "Regs " <> aVertexType a <> " " <> aName a <> "Command " <> aName a <> "Event",-           "",-           "type " <> aName a <> "EventStream =",-           "  ValidatedEventStream (HsPred " <> aName a <> "Regs " <> aName a <> "Command) " <> aName a <> "Regs " <> aVertexType a <> " " <> aName a <> "Command " <> aName a <> "Event",-           "",-           lowerFirst (aName a) <> "EventStreamDef :: " <> aName a <> "EventStreamDef",-           lowerFirst (aName a) <> "EventStreamDef =",-           "  EventStream",-           "    { transducer = " <> lowerFirst (aName a) <> "Transducer,",-           "      initialState = " <> initialVertex a <> ",",-           "      initialRegisters = initial" <> aName a <> "Regs,",-           "      eventCodec = " <> lowerFirst (aName a) <> "Codec,",-           "      resolveStreamName = Stream.streamName,",-           "      snapshotPolicy = " <> snapshotPolicyExpr a <> ","-         ]-      ++ stateCodecFieldLines a-      ++ [ "    }",-           ""-         ]-      ++ snapshotFixtureLines a-      ++ [ lowerFirst (aName a) <> "EventStream :: " <> aName a <> "EventStream",-           lowerFirst (aName a) <> "EventStream =",-           "  mkEventStreamOrThrow " <> tshow (aName a) <> " " <> lowerFirst (aName a) <> "EventStreamDef"-         ]-      ++ outcomeHandlerLines importPlan a silentOutcomes-  where-    categoryName = staticCategory ("aggregate " <> aName a) (lowerFirst (aName a))-    outcomeEnabled = isJust (aDomainOutcomeTypes a)-    silentOutcomes = resolvedSilentOutcomes a-    outcomeExpressions = map resolvedSilentReason silentOutcomes-    outcomeResultTypes = case aDomainOutcomeTypes a of-      Nothing -> []-      Just outcomeTypes -> [resolvedRejectionType outcomeTypes, resolvedNoOpType outcomeTypes]-    outcomeImportTypes =-      nub-        ( outcomeResultTypes-            <> concatMap typedExpressionImportTypes outcomeExpressions-            <> concatMap typedExpressionLiteralTypes outcomeExpressions-        )-    consumerLiteralNominals = nub [nominal | expression <- outcomeExpressions, nominal <- typedConsumerLiteralNominals expression]-    importPlan = eventStreamImportPlan a outcomeImportTypes consumerLiteralNominals-    consumerImports = T.lines (renderPlannedImports importPlan)-    generatedOutcomeNominals =-      stableNominals-        ( generatedNominalsInTypes outcomeResultTypes-            <> [nominal | expression <- outcomeExpressions, nominal <- typedGeneratedNominals expression]-        )-    generatedLiteralNominals =-      stableNominals-        [ nominal-        | expression <- outcomeExpressions,-          literal <- typedExpressionLiterals expression,-          nominal <- typedGeneratedNominals literal-        ]-    generatedOutcomeNominalImports =-      generatedNominalTypeImportsWithParsers-        (aggregateCheckedService a)-        (aContext a)-        generatedOutcomeNominals-        generatedLiteralNominals-    projectionTargets = nub (concatMap projectionAliasTargets outcomeExpressions)-    structuralProjectionImports =-      [ "import " <> structuralProjectionModule (aContext a) <> " qualified as StructuralProjections"-      | any isStructuralProjection projectionTargets-      ]-    generatedNominalProjectionImports =-      [ "import " <> generatedNominalModule (aContext a) <> " qualified as GeneratedNominals"-      | any isGeneratedNominalProjection projectionTargets-      ]-    consumerNominalProjectionImports =-      [ "import " <> nominalProjectionModule (aContext a) <> " qualified as NominalProjections"-      | any isConsumerNominalProjection projectionTargets-      ]-    outcomeUsesRegisterRoot = any (anyTypedExpression usesRegisterRoot) outcomeExpressions-    outcomeUsesCommandRoot = any (anyTypedExpression usesCommandRoot) outcomeExpressions-    outcomeUsesLabels = outcomeUsesCommandRoot || not (null projectionTargets)-    outcomeUsesText =-      AggregateText `elem` outcomeImportTypes-        || any (anyTypedExpression isTextLiteral) outcomeExpressions-        || any isNominalProjection projectionTargets-    outcomeUsesTimeLiteral = any (anyTypedExpression isTimeLiteral) outcomeExpressions-    outcomeUsesTimeType = AggregateTime `elem` outcomeImportTypes-    outcomeUsesNaturalType = AggregateNatural `elem` outcomeImportTypes-    outcomeUsesConsumerNominalLiteral = not (null consumerLiteralNominals)-    outcomeUsesConsumerIdLiteral = any (isIdRepresentation . resolvedNominalRepresentation) consumerLiteralNominals-    usedOperators = nub (concatMap outcomeExpressionOperators outcomeExpressions)-    keikiCoreImport-      | not outcomeEnabled = "import Keiki.Core (HsPred)"-      | otherwise =-          "import Keiki.Core (EdgeRef (..), HsPred"-            <> T.concat [", (" <> operator <> ")" | operator <- expressionOperatorOrder, operator `elem` usedOperators]-            <> ")"-    usesRegisterRoot expression = case typedScalarNode expression of-      TypedRoot ScalarRegisterRoot {} -> True-      TypedProject provenance _ -> case provenance of-        ScalarRegisterRoot {} -> True-        ScalarCommandRoot {} -> False-      _ -> False-    usesCommandRoot expression = case typedScalarNode expression of-      TypedRoot ScalarCommandRoot {} -> True-      TypedProject provenance _ -> case provenance of-        ScalarCommandRoot {} -> True-        ScalarRegisterRoot {} -> False-      _ -> False-    isTextLiteral expression = case typedScalarNode expression of-      TypedLiteral ScalarTextValue {} -> True-      _ -> False-    isTimeLiteral expression = case typedScalarNode expression of-      TypedLiteral ScalarTimeValue {} -> True-      _ -> False-    isNominalProjection NominalProjectionAlias {} = True-    isNominalProjection StructuralProjectionAlias {} = False-    isIdRepresentation IdRepresentation {} = True-    isIdRepresentation _ = False--outcomeHandlerLines :: HaskellImportPlan -> Agg -> [ResolvedSilentOutcome] -> [Text]-outcomeHandlerLines importPlan aggregate silentOutcomes = case aDomainOutcomeTypes aggregate of-  Nothing -> []-  Just outcomeTypes ->-    [ "",-      handlerName,-      "  :: DomainCommandHandler",-      "       (HsPred " <> aName aggregate <> "Regs " <> aName aggregate <> "Command)",-      "       " <> aName aggregate <> "Regs",-      "       " <> aVertexType aggregate,-      "       " <> aName aggregate <> "Command",-      "       " <> aName aggregate <> "Event",-      "       " <> renderDomainType importPlan aggregate (resolvedRejectionType outcomeTypes),-      "       " <> renderDomainType importPlan aggregate (resolvedNoOpType outcomeTypes),-      handlerName <> " =",-      "  DomainCommandHandler " <> lowerFirst (aName aggregate) <> "EventStream " <> classifierName,-      "",-      classifierName,-      "  :: SilentCommandContext " <> aName aggregate <> "Regs " <> aVertexType aggregate <> " " <> aName aggregate <> "Command",-      "  -> SilentDomainDecision",-      "       " <> renderDomainType importPlan aggregate (resolvedRejectionType outcomeTypes),-      "       " <> renderDomainType importPlan aggregate (resolvedNoOpType outcomeTypes),-      classifierName <> " (SilentCommandContext _ registers command (EdgeRef edgeSource edgeIndex)) =",-      "  case edgeSource of"-    ]-      ++ concatMap renderSourceGroup sourceGroups-      ++ [ "    _ -> outcomeInvariant edgeSource edgeIndex",-           " where",-           "  outcomeInvariant source index =",-           "    error ("-             <> tshow ("generated domain outcome invariant failed for aggregate " <> aName aggregate <> " edge ")-             <> " <> show source <> \"#\" <> show index)"-         ]-  where-    handlerName = lowerFirst (aName aggregate) <> "DomainCommandHandler"-    classifierName = lowerFirst (aName aggregate) <> "SilentDecision"-    sourceGroups =-      [ (source, filter ((== source) . tSource . layoutTransition . resolvedSilentLayout) silentOutcomes)-      | source <- nub (map (tSource . layoutTransition . resolvedSilentLayout) silentOutcomes)-      ]-    renderSourceGroup (source, outcomes) =-      [ "    " <> vertexCtor aggregate source <> " ->",-        "      case edgeIndex of"-      ]-        ++ map renderArm outcomes-        ++ ["        _ -> outcomeInvariant edgeSource edgeIndex"]-    renderArm outcome =-      let entry = resolvedSilentLayout outcome-          transition = layoutTransition entry-          constructor = case resolvedSilentKind outcome of-            RejectedOutcome -> "SilentRejected"-            NoOpOutcome -> "SilentNoOp"-       in "        "-            <> tshow' (layoutOutgoingIndex entry)-            <> " -> "-            <> constructor-            <> " ("-            <> renderOutcomeReasonEvaluation importPlan aggregate transition (resolvedSilentReason outcome)-            <> ")"--eventStreamImportPlan :: Agg -> [ResolvedAggregateType] -> [ResolvedNominalType] -> HaskellImportPlan-eventStreamImportPlan aggregate importedTypes literalNominals =-  planImportsOrDie-    (aGenPrefix aggregate <> ".EventStream")-    localDeclarations-    ( Set.unions-        [ aggregateSourceReferences (aggregateConsumerHaskellSource (aSymbols aggregate) resolvedType)-        | resolvedType <- importedTypes-        ]-        <> Set.fromList-          [ reference-          | nominal <- literalNominals,-            ConsumerNominal binding <- [resolvedNominalOwnership nominal],-            reference <--              qualifiedValueReference (consumerNominalBinding binding)-                : case resolvedNominalRepresentation nominal of-                  EnumRepresentation constructors ->-                    [ nominalRepresentationConstructorReference (aContext aggregate) nominal constructor-                    | (constructor, _) <- NE.toList constructors-                    ]-                  _ -> []-          ]-    )-  where-    localDeclarations =-      Set.fromList-        ( [ aVertexType aggregate,-            aName aggregate <> "Command",-            aName aggregate <> "Event",-            aName aggregate <> "Regs",-            aName aggregate <> "EventStream",-            aName aggregate <> "EventStreamDef"-          ]-            <> map resolvedNominalName (aGeneratedNominals aggregate)-            <> [ resolvedNominalName nominal-               | resolvedType <- importedTypes,-                 AggregateNominal nominal <- [resolvedType],-                 GeneratedNominal <- [resolvedNominalOwnership nominal]-               ]-        )--snapshotPolicyExpr :: Agg -> Text-snapshotPolicyExpr aggregate = case aSnapshot aggregate of-  Nothing -> "Never"-  Just snapshot -> case snapPolicy snapshot of-    SnapEvery interval -> "Every " <> tshow' interval-    SnapOnTerminal -> "OnTerminal"--stateCodecExpr :: Agg -> Text-stateCodecExpr aggregate = case aSnapshot aggregate of-  Nothing -> "Nothing"-  Just snapshot ->-    "Just (withFoldFingerprint "-      <> foldFingerprintValue aggregate-      <> " (defaultStateCodec "-      <> tshow' (snapCodecVersion snapshot)-      <> "))"--transducerImport :: Agg -> Text-transducerImport aggregate-  | hasVersion2Ownership aggregate =-      "import "-        <> aGenPrefix aggregate-        <> ".Transducer ("-        <> (if hasSnapshot aggregate then lowerFirst (aName aggregate) <> "FoldFingerprint, " else "")-        <> lowerFirst (aName aggregate)-        <> "Transducer)"-  | otherwise =-      "import "-        <> aHolePrefix aggregate-        <> ".Holes ("-        <> lowerFirst (aName aggregate)-        <> "Transducer)"--foldFingerprintValue :: Agg -> Text-foldFingerprintValue aggregate-  | hasVersion2Ownership aggregate = lowerFirst (aName aggregate) <> "FoldFingerprint"-  | otherwise = tshow (aFoldFingerprint aggregate)--stateCodecFieldLines :: Agg -> [Text]-stateCodecFieldLines aggregate = case aSnapshot aggregate of-  Nothing -> ["      stateCodec = Nothing"]-  Just _-    | hasVersion2Ownership aggregate ->-        [ "      -- The snapshot discriminator composes: the spec's state-codec version (bump it",-          "      -- in the spec's `state-codec version=` clause), keiki's register and",-          "      -- control-state shape hashes, and this fold fingerprint derived from the",-          "      -- spec's transition surface (guards, writes, emits, states, register",-          "      -- initials, referenced rules). Spec-visible fold changes invalidate old",-          "      -- snapshots automatically. Version-2 Hole-owned transitions additionally",-          "      -- compose their explicit hand-owned FoldVersion tokens here; bump the",-          "      -- corresponding token whenever that Hole behavior changes.",-          "      stateCodec = " <> stateCodecExpr aggregate-        ]-    | otherwise ->-        [ "      -- The snapshot discriminator composes: the spec's state-codec version (bump it",-          "      -- in the spec's `state-codec version=` clause), keiki's register and",-          "      -- control-state shape hashes, and this fold fingerprint derived from the",-          "      -- spec's transition surface (guards, writes, emits, states, register",-          "      -- initials, referenced rules). Spec-visible fold changes invalidate old",-          "      -- snapshots automatically. Fold changes made ONLY in the hand-owned Holes",-          "      -- module are invisible here: bump `state-codec version=` manually or old",-          "      -- snapshots will be served stale.",-          "      stateCodec = " <> stateCodecExpr aggregate-        ]--snapshotFixtureLines :: Agg -> [Text]-snapshotFixtureLines aggregate = case aSnapshot aggregate of-  Nothing -> []-  Just snapshot ->-    [ lowerFirst (aName aggregate) <> "SnapshotFixture :: (Int, Text)",-      lowerFirst (aName aggregate) <> "SnapshotFixture = (" <> tshow' (snapCodecVersion snapshot) <> ", " <> tshow (snapShapeHash snapshot) <> ")",-      ""-    ]------------------------------------------------------------------------------------- Projection module-----------------------------------------------------------------------------------emitProjection :: Agg -> Text-emitProjection a = case aProjection a of-  Nothing ->-    nl-      ( renderGeneratedLanguagePragmas []-          <> [ generatedBanner,-               "module " <> aGenPrefix a <> ".Projection () where",-               "",-               "-- No projection declarations are present; this module keeps the generated manifest inventory total."-             ]-      )-  Just p ->-    nl-      [ generatedBanner,-        "module " <> aGenPrefix a <> ".Projection",-        "  ( " <> lowerFirst (projTable p) <> "Projection",-        "  , " <> lowerFirst (projTable p) <> "StatusFor",-        "  ) where",-        "",-        "import " <> aGenPrefix a <> ".Domain",-        "import " <> aHolePrefix a <> ".Holes (apply" <> pascal (projTable p) <> ")",-        "import Data.Text (Text)",-        "import Keiro.Projection (InlineProjection (..))",-        "",-        "-- The deterministic event->status mapping (hole-kind 3, /mapping/), derived",-        "-- from the spec's status-map. The read-model SQL that consumes it lives in",-        "-- the hand-owned Holes module (a DB-coupled hole, delegated to codd).",-        projectionTableComment a p,-        lowerFirst (projTable p) <> "StatusFor :: " <> aName a <> "Event -> Maybe Text",-        lowerFirst (projTable p) <> "StatusFor = \\case",-        nl (statusArms a p),-        "",-        lowerFirst (projTable p) <> "Projection :: InlineProjection " <> aName a <> "Event",-        lowerFirst (projTable p) <> "Projection =",-        "  InlineProjection",-        "    { name = " <> tshow (contextNameToProjName a p),-        "    , apply = apply" <> pascal (projTable p),-        "    }"-      ]--statusArms :: Agg -> ProjectionSpec -> [Text]-statusArms a p =-  [ "  " <> rcName e <> " {} -> " <> statusFor e-  | e <- aEvents a-  ]-    ++ ["  _ -> Nothing" | hasWildcard]-  where-    pairs = maybe [] mapPairs (projStatusMap p)-    statusFor e = case lookup (rcName e) pairs of-      Just value -> "Just " <> tshow value-      Nothing -> "Nothing"-    -- A wildcard is only needed if some event is uncovered; otherwise every arm-    -- is explicit and a wildcard would be redundant (and -Wall would warn).-    hasWildcard = False--contextNameToProjName :: Agg -> ProjectionSpec -> Text-contextNameToProjName a p = contextKebab a <> "-" <> projTable p <> "-inline"--contextKebab :: Agg -> Text-contextKebab = kebabFromPascal . aCtxPascal--projectionReadModel :: Agg -> Maybe ReadModelNode-projectionReadModel aggregate = do-  projection <- aProjection aggregate-  find ((== projTable projection) . rmName) (aReadModels aggregate)--projectionTableComment :: Agg -> ProjectionSpec -> Text-projectionTableComment aggregate projection = case projectionReadModel aggregate of-  Nothing ->-    "-- WARNING: no readmodel node declares '"-      <> projTable projection-      <> "'; unqualified SQL depends on search_path."-  Just readModel ->-    "-- Qualified table "-      <> qualifiedTableLiteral readModel-      <> "; use "-      <> genPrefixFor (aContext aggregate) (pascal (rmName readModel))-      <> ".ReadModelTable."-      <> readModelStem readModel-      <> "QualifiedTable."------------------------------------------------------------------------------------- Holes module (create-if-absent)-----------------------------------------------------------------------------------emitHoles :: Agg -> Text-emitHoles aggregate-  | hasVersion2Ownership aggregate = emitVersion2Holes aggregate-  | otherwise = emitLegacyHoles aggregate--emitLegacyHoles :: Agg -> Text-emitLegacyHoles a =-  nl-    [ "{-# LANGUAGE BlockArguments #-}",-      "{-# LANGUAGE DataKinds #-}",-      "{-# LANGUAGE OverloadedRecordDot #-}",-      "{-# LANGUAGE QualifiedDo #-}",-      "{-# LANGUAGE TypeApplications #-}",-      "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never",-      "-- overwrites it. Fill the transducer body (and any other holes) against the",-      "-- generated signatures, then run the harness to confirm behaviour.",-      "module " <> aHolePrefix a <> ".Holes",-      "  ( " <> lowerFirst (aName a) <> "Transducer",-      holeProjectionExport a,-      holeUpcasterExports a,-      "  ) where",-      "",-      "import " <> aGenPrefix a <> ".Domain",-      "import Keiki.Builder ((=:))",-      "import qualified Keiki.Builder as B",-      "import Keiki.Core (HsPred, RegFile, SymTransducer, lit, (.==), (./=), (.||))",-      holeUpcasterImports a,-      holeProjectionImports a,-      "",-      "-- HOLE: the transducer body. Reproduce the structure below, replacing each",-      "-- `-- HOLE` line with the keiki symbolic operators it describes.",-      lowerFirst (aName a) <> "Transducer",-      "  :: SymTransducer",-      "       (HsPred " <> aName a <> "Regs " <> aName a <> "Command)",-      "       " <> aName a <> "Regs",-      "       " <> aVertexType a,-      "       " <> aName a <> "Command",-      "       " <> aName a <> "Event",-      lowerFirst (aName a) <> "Transducer =",-      "  B.buildTransducer " <> initialVertex a <> " initial" <> aName a <> "Regs isTerminal do",-      nl (concatMap (fromBlock a) (groupBySource a)),-      " where",-      "  isTerminal = \\case",-      nl ["    " <> vertexCtor a (stName s) <> " -> True" | s <- aStates a, stTerminal s],-      "    _ -> False",-      holeProjectionStub a,-      holeUpcasterStubs a-    ]--emitVersion2Holes :: Agg -> Text-emitVersion2Holes aggregate =-  nl $-    [ "{-# LANGUAGE BlockArguments #-}",-      "{-# LANGUAGE DataKinds #-}",-      "{-# LANGUAGE DuplicateRecordFields #-}",-      "{-# LANGUAGE OverloadedRecordDot #-}",-      "{-# LANGUAGE QualifiedDo #-}",-      "{-# LANGUAGE TypeApplications #-}",-      "-- This is a HAND-OWNED version-2 hook module. keiro-dsl creates it once",-      "-- and never overwrites it. Generated code owns every transition envelope",-      "-- and every declared guard/write. This module supplies explicit event-field",-      "-- mappings and explicitly selected Hole behavior only; fields(Command)",-      "-- identity mappings are generated directly and have no hook."-    ]-      ++ version2HoleModuleDeclaration aggregate-      ++ [ "",-           "import " <> aGenPrefix aggregate <> ".Domain",-           "import Keiki.Builder qualified as B",-           "import Keiki.Generics (RegFieldsOf)",-           holeUpcasterImports aggregate,-           holeProjectionImports aggregate-         ]-      ++ ["import Keiki.Core qualified as K" | anyHoleOwned aggregate || anyZeroFieldOutput aggregate]-      ++ ["import Keiro.Snapshot.Codec (FoldVersion (..))" | anyHoleOwned aggregate]-      ++ concatMap (uncurry (emitOutputHooks aggregate)) (transitionEntries aggregate)-      ++ concatMap (uncurry (emitHoleImplementation aggregate)) (transitionEntries aggregate)-      ++ [holeProjectionStub aggregate, holeUpcasterStubs aggregate]--anyZeroFieldOutput :: Agg -> Bool-anyZeroFieldOutput aggregate =-  or-    [ isHandOwned (outputMappingFor aggregate transitionIndex emitIndex)-        && null (rcFields (eventForName aggregate eventName))-    | (transitionIndex, transition) <- transitionEntries aggregate,-      (emitIndex, eventName) <- zip [1 ..] (tEmits transition)-    ]-  where-    isHandOwned HandOwnedEventOutput {} = True-    isHandOwned GeneratedCommandIdentity {} = False--version2HoleModuleDeclaration :: Agg -> [Text]-version2HoleModuleDeclaration aggregate = case version2HoleExports aggregate of-  [] -> ["module " <> aHolePrefix aggregate <> ".Holes () where"]-  firstExport : rest ->-    [ "module " <> aHolePrefix aggregate <> ".Holes",-      "  ( " <> firstExport-    ]-      ++ ["  , " <> value | value <- rest]-      ++ ["  ) where"]--version2HoleExports :: Agg -> [Text]-version2HoleExports aggregate =-  outputExports-    <> holeExports-    <> projectionExports-    <> [functionName | (_, _, functionName) <- upcasterEntries aggregate]-  where-    outputExports =-      [ outputFunctionName transitionIndex transition emitIndex eventName-      | (transitionIndex, transition) <- transitionEntries aggregate,-        (emitIndex, eventName) <- zip [1 ..] (tEmits transition),-        HandOwnedEventOutput {} <- [outputMappingFor aggregate transitionIndex emitIndex]-      ]-    holeExports =-      concat-        [ [holeFunctionName index transition, holeFoldVersionName index transition]-        | (index, transition) <- transitionEntries aggregate,-          tImplementation transition == HoleImplementation-        ]-    projectionExports = case aProjection aggregate of-      Nothing -> []-      Just projection -> ["apply" <> pascal (projTable projection)]--emitOutputHooks :: Agg -> Int -> Transition -> [Text]-emitOutputHooks aggregate transitionIndex transition =-  concat-    [ emitOutputHook aggregate transitionIndex transition emitIndex (eventForName aggregate eventName)-    | (emitIndex, eventName) <- zip [1 ..] (tEmits transition),-      HandOwnedEventOutput {} <- [outputMappingFor aggregate transitionIndex emitIndex]-    ]--emitOutputHook :: Agg -> Int -> Transition -> Int -> ResolvedCtor -> [Text]-emitOutputHook aggregate transitionIndex transition emitIndex event =-  [ "",-    "-- Hand-owned event-field hook inside the generated transition envelope.",-    functionName-      <> " :: "-      <> payloadProjectionType aggregate transition-      <> " -> "-      <> outputType,-    functionName <> " d = " <> outputValue-  ]-  where-    functionName = outputFunctionName transitionIndex transition emitIndex (rcName event)-    inputFields = "(" <> commandFieldsType transition <> ")"-    outputType-      | null (rcFields event) =-          "K.OutFields "-            <> aName aggregate-            <> "Regs "-            <> aName aggregate-            <> "Command "-            <> inputFields-            <> " ()"-      | otherwise =-          rcName event-            <> "TermFields "-            <> aName aggregate-            <> "Regs "-            <> aName aggregate-            <> "Command "-            <> inputFields-    outputValue-      | null (rcFields event) = "B.oNil"-      | otherwise =-          rcName event-            <> "TermFields\n"-            <> nl-              ( valueRecord-                  [ (fieldSelector identity, outputFieldValue identity fieldType)-                  | (identity, fieldType) <- rcFields event-                  ]-              )-    command = commandForTransition aggregate transition-    outputFieldValue identity fieldType-      | Just (commandIdentity, commandType) <- find ((== fieldDslName identity) . fieldDslName . fst) (rcFields command),-        commandType == fieldType =-          "d." <> fieldSelector commandIdentity-      | Just register <- find ((== fieldDslName identity) . rrName) (aRegs aggregate),-        rrType register == fieldType =-          "B.reg @" <> tshow (fieldDslName identity)-      | otherwise = "error " <> tshow ("HOLE: fill output field " <> rcName event <> "." <> fieldDslName identity)-    valueRecord fields =-      [ lead fieldIndex <> fieldName <> " = " <> fieldValue-      | (fieldIndex, (fieldName, fieldValue)) <- zip [0 :: Int ..] fields-      ]-        ++ ["  }"]-    lead 0 = "  { "-    lead _ = "  , "--emitHoleImplementation :: Agg -> Int -> Transition -> [Text]-emitHoleImplementation aggregate index transition-  | tImplementation transition /= HoleImplementation = []-  | otherwise =-      [ "",-        "-- HOLE: add the predicate and ordered register updates for this transition.",-        "-- The generated transducer still owns command matching, mode, emits, and goto.",-        holeFunctionName index transition-          <> " :: "-          <> payloadProjectionType aggregate transition-          <> " -> B.EdgeBuilder "-          <> aName aggregate-          <> "Regs "-          <> aName aggregate-          <> "Command "-          <> aName aggregate-          <> "Event "-          <> aVertexType aggregate-          <> " ('Just ("-          <> commandFieldsType transition-          <> ")) writes writes ()",-        holeFunctionName index transition <> " _d = B.requireGuard K.PTop",-        "",-        "-- Bump this token whenever the Hole predicate or updates change.",-        holeFoldVersionName index transition <> " :: FoldVersion",-        holeFoldVersionName index transition <> " = FoldVersion " <> tshow (transitionStem index transition <> "-fold-v1")-      ]---- | Export, import, and stub the per-event upcaster holes (EP-2 evolution).-holeUpcasterExports :: Agg -> Text-holeUpcasterExports a = case upcasterEntries a of-  [] -> ""-  es -> nl ["  , " <> fn | (_, _, fn) <- es]--holeUpcasterImports :: Agg -> Text-holeUpcasterImports a = case upcasterEntries a of-  [] -> ""-  _ -> nl ["import Data.Aeson (Value)", "import Data.Text (Text)"]--holeUpcasterStubs :: Agg -> Text-holeUpcasterStubs a = case upcasterEntries a of-  [] -> ""-  es ->-    nl $-      concat-        [ [ "",-            "-- HOLE upcaster: this hole receives ONLY " <> eventName <> " payloads stored at",-            "-- aggregate schema version " <> tshow' source <> "; other event kinds pass through the",-            "-- generated rung dispatch automatically. Bring this payload up one version and decide",-            "-- the default/derivation for any field added at the new version here.",-            fn <> " :: Value -> Either Text Value",-            fn <> " _ = Left \"HOLE: upcaster not implemented\""-          ]-        | (source, eventName, fn) <- es-        ]--holeProjectionExport :: Agg -> Text-holeProjectionExport a = case aProjection a of-  Nothing -> "  -- (no projection)"-  Just p -> "  , apply" <> pascal (projTable p)--holeProjectionImports :: Agg -> Text-holeProjectionImports aggregate = case projectionReadModel aggregate of-  Nothing -> ""-  Just readModel ->-    "import "-      <> genPrefixFor (aContext aggregate) (pascal (rmName readModel))-      <> ".ReadModelTable ("-      <> readModelStem readModel-      <> "QualifiedTable)"--holeProjectionStub :: Agg -> Text-holeProjectionStub a = case aProjection a of-  Nothing -> ""-  Just p ->-    nl-      ( [ "",-          "-- HOLE: the read-model SQL for the projection (a DB-coupled hole; the",-          "-- pure event->status mapping is generated as " <> lowerFirst (projTable p) <> "StatusFor)."-        ]-          ++ projectionGuidance-          ++ [ "apply" <> pascal (projTable p) <> " :: " <> aName a <> "Event -> recorded -> txn ()",-               "apply" <> pascal (projTable p) <> " _event _recorded = " <> projectionTableUse <> "error \"HOLE: fill " <> projTable p <> " projection apply\""-             ]-      )-    where-      projectionGuidance = case projectionReadModel a of-        Nothing ->-          ["-- WARNING: no readmodel node declares this table's schema; unqualified SQL depends on search_path."]-        Just readModel ->-          [ "-- Table: " <> qualifiedTableLiteral readModel <> ". Use " <> readModelStem readModel <> "QualifiedTable; never rely on search_path.",-            "-- Declared columns:"-          ]-            ++ map (("--   " <>) . readModelColumnDoc) (rmColumns readModel)-      projectionTableUse = case projectionReadModel a of-        Nothing -> ""-        Just readModel -> readModelStem readModel <> "QualifiedTable `seq` "---- Group transitions by source state, preserving order, for the B.from blocks.-groupBySource :: Agg -> [(Text, [Transition])]-groupBySource a =-  [ (source, map layoutTransition entries)-  | (source, entries) <- groupTransitionLayoutBySource (transitionLayout (transitionsOf a))-  ]---- We don't keep the original Aggregate around in Agg, so reconstruct--- transitions from a stored field. (Filled in resolveAgg via aTransitions.)-transitionsOf :: Agg -> [Transition]-transitionsOf = aTransitions--fromBlock :: Agg -> (Text, [Transition]) -> [Text]-fromBlock a (src, ts) =-  [ "    B.from " <> vertexCtor a src <> " do"-  ]-    ++ concatMap (onCmdBlock a) ts--onCmdBlock :: Agg -> Transition -> [Text]-onCmdBlock a t =-  [ "      B.onCmd inCtor" <> tCommand t <> " $ \\d -> B.do"-  ]-    -- Plan 143: the mode is structural, not hole-owned — a replay-only-    -- transition lowers to B.replayOnly (keiki ReplayOnly edge).-    ++ ["        B.replayOnly" | tMode t == TmReplayOnly]-    ++ maybe [] (\g -> ["        -- HOLE guard: " <> renderGuard g]) (tGuard t)-    ++ ["        -- HOLE write " <> r <> " := " <> renderGuard e | (r, e) <- tWrites t]-    ++ ["        -- HOLE emit " <> ev <> " (B.emit wire" <> ev <> " ...)" | ev <- tEmits t]-    ++ ["        B.goto " <> vertexCtor a (tGoto t)]------------------------------------------------------------------------------------- Field categories and shared helpers-----------------------------------------------------------------------------------data FieldCat-  = IdCat-  | EnumCat-  | MappedStructuralCat !StructuralDecl !ResolvedMappedShape-  | MappedOpaqueCat !OpaqueDecl-  | OtherCat-  deriving stock (Eq, Show)--fieldCat :: Agg -> ResolvedAggregateType -> FieldCat-fieldCat a ty-  | AggregateNominal nominal <- ty,-    IdRepresentation {} <- resolvedNominalRepresentation nominal =-      IdCat-  | AggregateNominal nominal <- ty,-    EnumRepresentation {} <- resolvedNominalRepresentation nominal =-      EnumCat-  | Just (ResolvedStructural declaration shape) <- mappedDeclFor a ty = MappedStructuralCat declaration shape-  | Just (ResolvedOpaque declaration) <- mappedDeclFor a ty = MappedOpaqueCat declaration-  | otherwise = OtherCat---- | The first constructor of a declared enum, used to build sample values.-firstEnumCtor :: Agg -> Text -> Maybe Text-firstEnumCtor a ty =-  case [c | e <- aEnums a, enumName e == ty, (c, _) <- take 1 (enumCtors e)] of-    (c : _) -> Just c-    [] -> Nothing--vertexCtor :: Agg -> Text -> Text-vertexCtor a s = aName a <> s--initialVertex :: Agg -> Text-initialVertex a = case aStates a of-  (s : _) -> vertexCtor a (stName s)-  [] -> aName a <> "Init"--generatedBanner :: Text-generatedBanner = "-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec."---- | The provenance line written by a concrete scaffold plan. The package--- version comes from Cabal's build metadata, while the language and origin come--- from the checked semantic input and the emitted module respectively.-generatedBannerFor :: EffectiveLanguageContract -> Text -> Text-generatedBannerFor languageContract sourceOrigin =-  "-- @generated by keiro-dsl "-    <> T.pack (showVersion Package.version)-    <> " (language keiro-dsl "-    <> languageVersionText (effectiveContractLanguageVersion languageContract)-    <> ") from "-    <> stableBannerOrigin sourceOrigin-    <> "; do not edit."---- Source line numbers are useful refusal metadata but are not stable ownership:--- moving an unchanged node within or between workspace members must not rewrite--- every Generated file. The node kind and name remain the banner authority.-stableBannerOrigin :: Text -> Text-stableBannerOrigin sourceOrigin =-  case T.breakOnEnd " (line " withoutMemberPath of-    (prefixWithMarker, lineWithClose)-      | not (T.null prefixWithMarker),-        Just lineNumber <- T.stripSuffix ")" lineWithClose,-        not (T.null lineNumber),-        T.all isDigit lineNumber ->-          T.dropEnd (T.length " (line ") prefixWithMarker-    _ -> withoutMemberPath-  where-    withoutMemberPath = case T.breakOn ": " sourceOrigin of-      (memberPath, attributedOrigin)-        | ".keiro" `T.isSuffixOf` memberPath,-          not (T.null attributedOrigin) ->-            T.drop 2 attributedOrigin-      _ -> sourceOrigin---- | Recognize the exact historical banner or the frozen stamped format. This--- intentionally rejects arbitrary comments that merely start with--- @-- \@generated@.-isGeneratedBannerLine :: Text -> Bool-isGeneratedBannerLine line =-  line == generatedBanner-    || ( stampedPrefix `T.isPrefixOf` line-           && " (language keiro-dsl " `T.isInfixOf` line-           && ") from " `T.isInfixOf` line-           && "; do not edit." `T.isSuffixOf` line-       )-  where-    stampedPrefix = "-- @generated by keiro-dsl "---- | Replace an emitter's legacy placeholder (or an earlier stamp) with the--- provenance for this plan. A Generated module with a specialized banner gets--- the standard stamp prepended, so every planned Generated file is covered.-stampGeneratedModule :: EffectiveLanguageContract -> ScaffoldModule -> ScaffoldModule-stampGeneratedModule languageContract moduleValue-  | kind moduleValue == HoleStub = moduleValue-  | otherwise = moduleValue {moduleText = stampedText}-  where-    banner = generatedBannerFor languageContract (origin moduleValue)-    sourceLines = T.splitOn "\n" (moduleText moduleValue)-    stampedText = case replaceFirstGeneratedBanner banner sourceLines of-      Nothing -> banner <> "\n" <> moduleText moduleValue-      Just linesWithStamp -> T.intercalate "\n" linesWithStamp--stampGeneratedModules :: EffectiveLanguageContract -> [ScaffoldModule] -> [ScaffoldModule]-stampGeneratedModules languageContract = map (stampGeneratedModule languageContract)--replaceFirstGeneratedBanner :: Text -> [Text] -> Maybe [Text]-replaceFirstGeneratedBanner _ [] = Nothing-replaceFirstGeneratedBanner replacement (line : rest)-  | isGeneratedBannerLine line = Just (replacement : rest)-  | otherwise = (line :) <$> replaceFirstGeneratedBanner replacement rest--nodeOrigin :: Text -> Text -> Loc -> Text-nodeOrigin nodeKind nodeName loc =-  nodeKind <> " " <> nodeName <> case unLoc loc of-    0 -> ""-    line -> " (line " <> tshow' line <> ")"---- | Conditions that the deterministic emitters cannot lower faithfully. The--- pre-write scaffold pipeline treats each returned message as a refusal. The--- list is extended alongside the policy and type lowering milestones.-scaffoldRefusals :: Spec -> [Text]-scaffoldRefusals spec = scaffoldRefusalsWithSymbols (aggregateSymbols spec) spec--scaffoldRefusalsForService :: CheckedService -> [Text]-scaffoldRefusalsForService service =-  scaffoldRefusalsWithSymbols-    (aggregateSymbolsFromGraphResult (checkedTypeGraph service) spec)-    spec-  where-    spec = checkedSpec service--scaffoldRefusalsWithSymbols :: AggregateSymbols -> Spec -> [Text]-scaffoldRefusalsWithSymbols symbols spec =-  concatMap aggregateRefusals aggregates-    <> concatMap contractRefusals contracts-    <> concatMap publisherRefusals publishers-  where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]-    contracts = [contract | NContract contract <- specNodes spec]-    publishers = [publisher | NPublisher publisher <- specNodes spec]-    aggregateRefusals aggregate =-      [ "AggregateEmpty: aggregate '" <> aggName aggregate <> "' must declare at least one command, event, and transition"-      | null (aggCommands aggregate) || null (aggEvents aggregate) || null (aggTransitions aggregate)-      ]-        <> concatMap (registerRefusals aggregate) (aggRegs aggregate)-        <> concatMap (fieldRefusals aggregate CommandFieldUse) (concatMap cmdFields (aggCommands aggregate))-        <> concatMap (fieldRefusals aggregate EventFieldUse) [field | event <- aggEvents aggregate, EventFields fields <- [evBody event], field <- fields]-    fieldRefusals aggregate useSite field = case inferAggregateFieldType symbols aggregate useSite field of-      Right _ -> []-      Left _ ->-        [ "FieldTypeUnrepresentable: aggregate '"-            <> aggName aggregate-            <> "' field '"-            <> aggregateFieldName field-            <> "' has unsupported explicit type '"-            <> maybe "(inferred)" typeExprCanonicalName (aggregateFieldType field)-            <> "'"-        ]-    registerRefusals aggregate register =-      case resolveAggregateType symbols (regLoc register) RegisterUse (regType register) of-        Left _ ->-          [ "RegTypeUnsupported: aggregate '"-              <> aggName aggregate-              <> "' register '"-              <> regName register-              <> "' has unsupported type '"-              <> typeExprCanonicalName (regType register)-              <> "'"-          ]-        Right resolved -> case resolveRegisterInitial symbols (regLoc register) resolved (regInitial register) of-          Right _ -> []-          Left _ -> [initialRefusal aggregate register resolved]-    initialRefusal aggregate register resolved = case resolved of-      AggregateText -> label "RegTextInitialNotQuoted" "must use a quoted Text initial"-      AggregateNominal nominal-        | EnumRepresentation {} <- resolvedNominalRepresentation nominal ->-            label "RegInitialNotEnumCtor" ("must start at the declaration-owned initial for enum '" <> resolvedNominalName nominal <> "'")-      AggregateMapped {} -> label "MappedRegisterInitialMissing" "requires the mapped declaration's initial symbol"-      _ -> label "RegInitialInvalidLiteral" ("has an invalid " <> aggregateCanonicalName resolved <> " initial")-      where-        label codeName detail = codeName <> ": aggregate '" <> aggName aggregate <> "' register '" <> regName register <> "' " <> detail-    contractRefusals contract =-      [ "ContractEmpty: contract '" <> ctrName contract <> "' must declare at least one event"-      | null (ctrEvents contract)-      ]-    publisherRefusals publisher =-      let backoff = pubBackoff publisher-          label message = message <> ": publisher '" <> pubName publisher <> "'"-       in case boKind backoff of-            "constant" -> []-            "exponential" -> case (boMax backoff, boMultiplier backoff) of-              (Just maximumWindow, Just multiplierText) ->-                case (windowSeconds (boWindow backoff), windowSeconds maximumWindow, readMaybe (T.unpack multiplierText) :: Maybe Double) of-                  (Right initialSeconds, Right maximumSeconds, Just multiplier)-                    | initialSeconds > 0 && maximumSeconds >= initialSeconds && multiplier >= 1 -> []-                  _ -> [label "BackoffInvalidExponential"]-              _ -> [label "BackoffExponentialIncomplete"]-            other -> [label ("BackoffUnknownKind '" <> other <> "'")]--windowSeconds :: Text -> Either Text Int-windowSeconds window = case T.unsnoc window of-  Just (digits, unit)-    | not (T.null digits),-      Just amount <- readMaybe (T.unpack digits) -> case unit of-        's' -> Right amount-        'm' -> Right (amount * 60)-        'h' -> Right (amount * 3600)-        _ -> Left invalid-  _ -> Left invalid-  where-    invalid = "invalid window '" <> window <> "' (expected digits followed by s, m, or h)"--windowText :: Text -> Text-windowText = either (const "0") tshow' . windowSeconds---- | Render an Expr back to source-ish text for a hole annotation.-renderGuard :: Expr -> Text-renderGuard = renderExpr------------------------------------------------------------------------------------- Text helpers-----------------------------------------------------------------------------------nl :: [Text] -> Text-nl = T.intercalate "\n"---- | Join groups of declarations, blank-line-separated, dropping empties.-sectionsOf :: [[Text]] -> Text-sectionsOf = T.intercalate "\n\n" . filter (not . T.null) . map (T.intercalate "\n\n")--lowerFirst :: Text -> Text-lowerFirst = generatedCase HaskellName.LogicalIdentifier False---- | Assert the shared category proof at emission time as a belt-and-braces--- guard for callers that bypass the CLI's normal validate-before-scaffold path.-staticCategory :: Text -> Text -> Text-staticCategory owner value = case sagaCategoryError value of-  Nothing -> value-  Just reason -> error (T.unpack ("keiro-dsl scaffold: illegal " <> owner <> " category " <> tshow value <> " " <> reason))--pascal :: Text -> Text-pascal = generatedCase HaskellName.LogicalIdentifier True--pascalFromKebab :: Text -> Text-pascalFromKebab = generatedCase HaskellName.LogicalWireWord True--generatedCase :: HaskellName.NameSourceKind -> Bool -> Text -> Text-generatedCase source upper name =-  case HaskellName.deriveHaskellName source site of-    Right derived-      | upper -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-      | otherwise -> HaskellName.renderLowerCamelName (HaskellName.lowerCamel derived)-    Left _ -> name-  where-    site =-      HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedHelperSite,-          HaskellName.siteLogicalName = name,-          HaskellName.siteOwner = "scaffold-renderer",-          HaskellName.siteLine = 0+    modernizeScaffoldModule,+    stampGeneratedModule,+    stampGeneratedModules,+  )+where++import Data.Char (isAlpha, isAlphaNum, isDigit, isUpper)+import Data.List (find, groupBy, isSuffixOf, nub, sort, sortOn)+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe, maybeToList)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Version (showVersion)+import Keiro.Dsl.AggregateGenerationPlan+import Keiro.Dsl.AggregateType+import Keiro.Dsl.BehaviorCoverage qualified as Behavior+import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource+import Keiro.Dsl.CodecCompare (BranchArm (..), BranchField (..), BranchSchema (..))+import Keiro.Dsl.ConsumerTypePlan+import Keiro.Dsl.EventOutput+import Keiro.Dsl.ExplainBindings (BindingObligation (..), BindingObligationKind (..), bindingObligations, bindingObligationsForService)+import Keiro.Dsl.Expression+import Keiro.Dsl.FieldIdentity+import Keiro.Dsl.FoldFingerprint (aggregateFoldFingerprintForService, renderFoldSurfaceError)+import Keiro.Dsl.GeneratedHaskellLanguage+import Keiro.Dsl.Grammar+import Keiro.Dsl.HaskellImport+import Keiro.Dsl.HaskellName qualified as HaskellName+import Keiro.Dsl.IdDomain (IdDomainContract, contractIdDomainContractFor, idDomainContractFor, idDomainPrefix, idDomainSampleText)+import Keiro.Dsl.LanguageVersion (SourceLanguage (LegacyUnversioned), languageVersionText)+import Keiro.Dsl.MappedCodecPlan+import Keiro.Dsl.NominalType+import Keiro.Dsl.PrettyPrint (renderExpr)+import Keiro.Dsl.ProjectionMappedImpact (projectionAggregateSourceFingerprint, projectionAggregateSourceFingerprintForService)+import Keiro.Dsl.ProjectionSupply+import Keiro.Dsl.ReadModelShape (fnv1a64, registryNameFor, subscriptionNameFor)+import Keiro.Dsl.RouterSelection+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedProjectionSupplies, checkedSpec, checkedTypeGraph, effectiveLanguageContract, legacyCheckedService)+import Keiro.Dsl.SourceIndex qualified as SourceIndex+import Keiro.Dsl.TypeGraph+import Keiro.Dsl.Validate (sagaCategoryError)+import Paths_keiro_dsl qualified as Package+import Text.Read (readMaybe)++-- | One emitted module: its on-disk path (relative to the scaffold @--out@+-- directory), its full text, and whether it is overwritten every run+-- ('Generated') or written only when absent ('HoleStub').+data ScaffoldModule = ScaffoldModule+  { path :: !FilePath,+    text :: !Text,+    kind :: !ModuleKind,+    origin :: !Text+  }+  deriving stock (Eq, Show)++-- | Stable semantic identity for a generated artifact.  It is deliberately+-- independent of the cased module path: source-name migrations pair artifacts+-- by this role, then compare their old and current paths.+data ModuleRole = ModuleRole+  { ownerKind :: !Text,+    ownerName :: !Text,+    family :: !Text+  }+  deriving stock (Eq, Ord, Show)++moduleRole :: ScaffoldModule -> ModuleRole+moduleRole scaffoldModule =+  ModuleRole+    { ownerKind = headOr "module" originWords,+      ownerName = (.origin) scaffoldModule,+      family = case reverse (T.splitOn "." moduleName) of+        family : _ -> family+        [] -> moduleName+    }+  where+    originWords = T.words ((.origin) scaffoldModule)+    moduleName = T.replace "/" "." (T.dropEnd 3 (T.pack ((.path) scaffoldModule)))+    headOr fallback = \case+      value : _ -> value+      [] -> fallback++data ModuleKind+  = -- | @-- \@generated@; overwritten on every scaffold.+    Generated+  | -- | Hand-owned; created only when absent, never overwritten.+    HoleStub+  deriving stock (Eq, Show)++-- | The threading context: the spec's @context@ name, the chosen output+-- module-namespace root, and the placement style. Extended additively (never+-- re-shaped) by later verticals.+data Context = Context+  { name :: !Text,+    -- | @""@ means no namespace prefix (the historical default).+    moduleRoot :: !Text,+    -- | 'GeneratedPrefix' is the historical default.+    placement :: !Placement+  }+  deriving stock (Eq, Show)++-- | One aggregate-level reason a generated nominal declaration must be visible.+-- The declaration itself is context-owned; these use sites determine the+-- aggregate modules that import it.+data NominalUseSite = NominalUseSite+  { aggregate :: !Name,+    kind :: !AggregateUseSite+  }+  deriving stock (Eq, Ord, Show)++-- | The checked generation owner for one unbound ID or enum. Every owner in a+-- service points at the same context-level module, while retaining its source+-- location through 'ResolvedNominalType' and all aggregate use sites explicitly.+data NominalGenerationOwner = NominalGenerationOwner+  { declaration :: !ResolvedNominalType,+    moduleName :: !Text,+    useSites :: !(Set.Set NominalUseSite),+    equalityUsed :: !Bool+  }+  deriving stock (Eq, Show)++-- | A context with today's default placement ('GeneratedPrefix', no root prefix)+-- for the given @context@ name. Callers that do not care about placement (the+-- @parse@ path, tests) build their context with this.+defaultContext :: Text -> Context+defaultContext name = Context {name = name, moduleRoot = "", placement = GeneratedPrefix}++-- | The generated-layer namespace for a node, honouring the root prefix and the+-- placement style. The 'Text' argument is the already-pascalised node name (e.g.+-- @Reservation@, @HospitalSurge@). For 'GeneratedPrefix' this is+-- @\<root\>.Generated.\<Ctx\>.\<Node\>@ (identical to the historical layout); for+-- 'CollocatedLeaf' it is @\<root\>.\<Ctx\>.\<Node\>.Generated@.+genPrefixFor :: Context -> Text -> Text+genPrefixFor ctx node = case (.placement) ctx of+  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> "." <> node+  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> "." <> node <> ".Generated"++-- | The generated-layer namespace shared by modules emitted once for a whole+-- service context, such as Nominals, ReplayAudit, and Conformance.+contextGeneratedPrefix :: Context -> Text+contextGeneratedPrefix ctx = case (.placement) ctx of+  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx+  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated"++-- | The hand-owned (hole) namespace for a node: @\<root\>.\<Ctx\>.\<Node\>@ —+-- the same for both placement styles (holes always sit beside the domain).+holePrefixFor :: Context -> Text -> Text+holePrefixFor ctx node = rootPrefix ctx <> ctxPascalOf ctx <> "." <> node++-- | The one context-level Haskell owner for generated IDs and enums.+generatedNominalModule :: Context -> Text+generatedNominalModule ctx = contextGeneratedPrefix ctx <> ".Nominals"++-- | Emit the one context-owned table that contains every current behavior+-- source position. Services without behavior requirements emit no table and,+-- consequently, no aggregate behavior contract imports one.+behaviorSourceMapModule :: Context -> [BehaviorSource.BehaviorSourceEntry] -> Maybe ScaffoldModule+behaviorSourceMapModule _ [] = Nothing+behaviorSourceMapModule ctx entries =+  Just+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+        text =+          nl+            ( renderGeneratedLanguagePragmas []+                <> [ generatedBanner,+                     "module " <> moduleName,+                     "  ( BehaviorSourceLocation (..)",+                     "  , behaviorSourceLocation",+                     "  , renderBehaviorSourceLocation",+                     "  ) where",+                     "",+                     "import Data.Text (Text)",+                     "import Data.Text qualified as T",+                     "",+                     "data BehaviorSourceLocation = BehaviorSourceLocation",+                     "  { sourceFile :: !FilePath",+                     "  , sourceLine :: !Int",+                     "  , sourceColumn :: !Int",+                     "  }",+                     "  deriving stock (Eq, Ord, Show)",+                     "",+                     "behaviorSourceLocation :: Text -> Maybe BehaviorSourceLocation",+                     "behaviorSourceLocation key = case key of"+                   ]+                <> [ "  "+                       <> tshow (Behavior.unBehaviorKey ((.key) entry))+                       <> " -> Just (BehaviorSourceLocation "+                       <> tshow (T.pack ((.file) entry))+                       <> " "+                       <> tshow' ((.line) entry)+                       <> " "+                       <> tshow' ((.column) entry)+                       <> ")"+                   | entry <- sortOn (.key) entries+                   ]+                <> [ "  _ -> Nothing",+                     "",+                     "renderBehaviorSourceLocation :: Text -> Text",+                     "renderBehaviorSourceLocation key = case behaviorSourceLocation key of",+                     "  Just location -> T.pack location.sourceFile <> \":\" <> tshow location.sourceLine <> \":\" <> tshow location.sourceColumn",+                     "  Nothing -> \"<internal invariant: missing behavior source for \" <> key <> \">\"",+                     "",+                     "tshow :: Show value => value -> Text",+                     "tshow = T.pack . show"+                   ]+            ),+        kind = Generated,+        origin = "context " <> (.name) ctx <> " behavior source map"+      }+  where+    moduleName = contextGeneratedPrefix ctx <> ".BehaviorSourceMap"++-- | The root namespace prefix, dot-terminated, or @""@ when no root is set.+rootPrefix :: Context -> Text+rootPrefix ctx = case (.moduleRoot) ctx of r | T.null r -> ""; r -> r <> "."++-- | The context name in PascalCase, e.g. @hospital-capacity@ -> @HospitalCapacity@.+ctxPascalOf :: Context -> Text+ctxPascalOf = pascalFromKebab . (.name)++--------------------------------------------------------------------------------+-- Firewall self-check (M3)+--------------------------------------------------------------------------------++-- | The canonical keiki surface forbidden in generated modules. Symbolic+-- operators are matched as maximal Haskell symbol tokens, identifiers as complete+-- tokens, qualifiers by their leading module alias, and imports structurally.+data FirewallSurface = FirewallSurface+  { forbiddenSymbolic :: ![Text],+    forbiddenIdents :: ![Text],+    forbiddenQualifiers :: ![Text],+    forbiddenImports :: ![Text],+    restrictedImports :: ![(Text, [Text])]+  }+  deriving stock (Eq, Show)++firewallSurface :: FirewallSurface+firewallSurface =+  FirewallSurface+    { forbiddenSymbolic = [".==", "./=", ".<", ".<=", ".>", ".>=", ".&&", ".||", ".+", ".-", ".*", "=:", "*:"],+      forbiddenIdents = ["lit", "pnot", "tadd", "tsub", "tmul"],+      forbiddenQualifiers = ["B"],+      forbiddenImports = ["Keiki.Builder", "Keiki.Operators", "Keiki.Symbolic"],+      -- Generated aggregate modules use the first two names; generated+      -- harnesses validate, step, and replay filled holes register by register.+      restrictedImports =+        [ ( "Keiki.Core",+            [ "RegFile",+              "HsPred",+              "FieldProjection",+              "ExactFieldProjection",+              "FieldWitness",+              "fieldWitness",+              "exactFieldWitness",+              "fieldWitnessGet",+              "fieldWitnessAgrees",+              "applyEventsEither",+              "defaultValidationOptions",+              "step",+              "validateTransducer",+              "EdgeMode",+              "EdgeRef",+              "StepSuccess",+              "StepFailure",+              "ReplayEventSpan",+              "ReplayAttribution",+              "ReplaySuccess",+              "applyEventsDetailedEither",+              "stepDetailedEither",+              "!"+            ]+          )+        ]+    }++-- | Scan generated modules for firewall breaches, returning every offending+-- @(module path, token, 1-based line number)@. Only modules whose 'kind' is+-- 'Generated' are scanned. Strings and comments are skipped, symbol runs use+-- maximal munch, and keiki imports are checked independently of token spelling.+firewallBreaches :: [ScaffoldModule] -> [(FilePath, Text, Int)]+firewallBreaches mods =+  [ ((.path) m, breach, n)+  | m <- mods,+    (.kind) m == Generated,+    not (authoritativeScalarModule m),+    (n, line) <- zip [1 ..] (T.lines ((.text) m)),+    breach <- lineBreaches line+  ]++-- The version-2 aggregate transducer and an outcome-enabled aggregate event+-- stream are the narrow, intentional exceptions to the generated+-- symbolic-operator firewall. The former owns transition terms; the latter+-- evaluates a checked reason term only after Keiki has selected an exact edge.+-- Ordinary event-stream modules remain scanned.+authoritativeScalarModule :: ScaffoldModule -> Bool+authoritativeScalarModule scaffoldModule =+  "/Transducer.hs" `isSuffixOf` path+    || ( "/EventStream.hs" `isSuffixOf` path+           && "DomainCommandHandler" `T.isInfixOf` (.text) scaffoldModule+       )+  where+    path = (.path) scaffoldModule++lineBreaches :: Text -> [Text]+lineBreaches line = case importModule line of+  Just _ -> importBreaches line+  Nothing -> tokenBreaches (codeTokens line)+  where+    tokenBreaches = mapMaybe breachFor+    breachFor (IdentToken ident)+      | ident `elem` (.forbiddenIdents) firewallSurface = Just ident+    breachFor (QualifiedToken qualifier)+      | qualifier `elem` (.forbiddenQualifiers) firewallSurface = Just (qualifier <> ".*")+    breachFor (SymbolToken symbol)+      | symbol `elem` (.forbiddenSymbolic) firewallSurface = Just symbol+    breachFor _ = Nothing++data CodeToken = IdentToken !Text | QualifiedToken !Text | SymbolToken !Text++codeTokens :: Text -> [CodeToken]+codeTokens = go . T.unpack+  where+    go [] = []+    go ('-' : '-' : _) = []+    go ('"' : rest) = go (dropString rest)+    go ('\'' : rest) = go (dropChar rest)+    go (c : rest)+      | isIdentStart c =+          let (identTail, afterIdent) = span isIdentContinue rest+              ident = T.pack (c : identTail)+           in case afterIdent of+                '.' : next : more+                  | isUpper c && isIdentStart next ->+                      let (_member, afterMember) = span isIdentContinue more+                       in QualifiedToken ident : go afterMember+                _ -> IdentToken ident : go afterIdent+      | isSymbolChar c =+          let (symbolTail, afterSymbol) = span isSymbolChar rest+           in SymbolToken (T.pack (c : symbolTail)) : go afterSymbol+      | otherwise = go rest+    isIdentStart c = isAlpha c || c == '_'+    isIdentContinue c = isAlphaNum c || c == '_' || c == '\''+    isSymbolChar c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)+    dropString [] = []+    dropString ('\\' : _escaped : rest) = dropString rest+    dropString ('"' : rest) = rest+    dropString (_ : rest) = dropString rest+    dropChar [] = []+    dropChar ('\\' : _escaped : rest) = dropChar rest+    dropChar ('\'' : rest) = rest+    dropChar (_ : rest) = dropChar rest++importBreaches :: Text -> [Text]+importBreaches line = case importModule line of+  Nothing -> []+  Just imported+    | imported `elem` (.forbiddenImports) firewallSurface -> ["import:" <> imported]+    | Just allowed <- lookup imported ((.restrictedImports) firewallSurface),+      not (hasAllowedExplicitImportList allowed line) ->+        ["import:" <> imported]+    | otherwise -> []++importModule :: Text -> Maybe Text+importModule line = case T.words (T.strip line) of+  "import" : rest -> find (T.isPrefixOf "Keiki.") rest+  _ -> Nothing++hasAllowedExplicitImportList :: [Text] -> Text -> Bool+hasAllowedExplicitImportList allowed line =+  case (T.breakOn "(" line, T.breakOnEnd ")" line) of+    ((_, open), (close, _))+      | not (T.null open) && not (T.null close) ->+          let inside = T.takeWhile (/= ')') (T.drop 1 open)+              names = filter (not . T.null) (T.split (not . isAlphaNum) inside)+           in all (`elem` allowed) names+    _ -> False++--------------------------------------------------------------------------------+-- Derived naming+--------------------------------------------------------------------------------++-- | Resolved, denormalized view of an aggregate used by every emitter.+data Agg = Agg+  { context :: !Context,+    checkedService :: !CheckedService,+    languageContract :: !EffectiveLanguageContract,+    spec :: !Spec,+    aggregate :: !Aggregate,+    ctxPascal :: !Text,+    name :: !Text,+    loc :: !Loc,+    vertexType :: !Text,+    ids :: ![IdDecl],+    enums :: ![EnumDecl],+    regs :: ![ResolvedRegister],+    states :: ![StateDecl],+    commands :: ![ResolvedCtor],+    events :: ![ResolvedCtor],+    domainOutcomeTypes :: !(Maybe ResolvedDomainOutcomeTypes),+    -- | Generated IDs and enums used by this aggregate, in stable name order.+    generatedNominals :: ![ResolvedNominalType],+    transitions :: ![Transition],+    outputMappings :: !(Map.Map (Int, Int) EventOutputMapping),+    wire :: !WireSpec,+    projection :: !(Maybe ProjectionSpec),+    snapshot :: !(Maybe SnapshotSpec),+    foldFingerprint :: !Text,+    readModels :: ![ReadModelNode],+    typeGraph :: !(Maybe TypeGraph),+    symbols :: !AggregateSymbols,+    -- | e.g. @Generated.HospitalCapacity.Reservation@+    genPrefix :: !Text,+    -- | e.g. @HospitalCapacity.Reservation@+    holePrefix :: !Text+  }++data ResolvedDomainOutcomeTypes = ResolvedDomainOutcomeTypes+  { rejectionType :: !ResolvedAggregateType,+    noOpType :: !ResolvedAggregateType+  }+  deriving stock (Eq, Show)++aggregateCheckedService :: Agg -> CheckedService+aggregateCheckedService = (.checkedService)++data ResolvedRegister = ResolvedRegister+  { name :: !Name,+    valueType :: !ResolvedAggregateType,+    initial :: !ResolvedRegisterInitial,+    loc :: !Loc+  }+  deriving stock (Eq, Show)++-- | A command or event constructor with its fully-resolved field identities and+-- aggregate types.+data ResolvedCtor = ResolvedCtor+  { name :: !Text,+    -- | (DSL/selector/wire identity, canonical aggregate type)+    fields :: ![(ResolvedFieldIdentity, ResolvedAggregateType)],+    -- | EP-2: schema version (1 for commands and unversioned events).+    version :: !Int,+    -- | EP-2: the source version this event migrates from (the upcaster step).+    upcastFrom :: !(Maybe Int)+  }++defaultWire :: WireSpec+defaultWire = WireSpec {kind = "ctorName", fields = "camelCase", schemaVersion = 1}++resolveAgg :: Context -> Spec -> Aggregate -> Agg+resolveAgg ctx spec = resolveAggForService ctx (legacyCheckedService spec)++-- | Resolve one aggregate under the service's effective runtime semantics.+resolveAggForService :: Context -> CheckedService -> Aggregate -> Agg+resolveAggForService ctx service agg =+  Agg+    { context = ctx,+      checkedService = service,+      languageContract = checkedLanguageContract service,+      spec = spec,+      aggregate = agg,+      ctxPascal = ctxPascal,+      name = nm,+      loc = (.loc) agg,+      vertexType = vertexType,+      ids = (.ids) spec,+      enums = (.enums) spec,+      regs = map resolveRegister ((.regs) agg),+      states = (.states) agg,+      commands = map resolveCommand ((.commands) agg),+      events = map resolveEvent ((.events) agg),+      domainOutcomeTypes = resolvedDomainOutcomeTypes,+      generatedNominals = generatedNominalsInTypes aggregateResolvedTypes,+      transitions = (.transitions) agg,+      outputMappings =+        Map.fromList+          [ ( (transitionIndex, emitIndex),+              orDieOutput (eventOutputMappingFromGraphResult typeGraphResult spec agg transition emitIndex eventName)+            )+          | (transitionIndex, transition) <- zip [1 ..] ((.transitions) agg),+            (emitIndex, eventName) <- zip [1 ..] ((.emits) transition)+          ],+      wire = fromMaybe defaultWire ((.wire) agg),+      projection = (.projection) agg,+      snapshot = (.snapshot) agg,+      foldFingerprint = either (error . T.unpack . renderFoldSurfaceError) id (aggregateFoldFingerprintForService service agg),+      readModels = [readModel | NReadModel readModel <- (.nodes) spec],+      typeGraph = either (const Nothing) Just typeGraphResult,+      symbols = symbols,+      genPrefix = genPrefixFor ctx nm,+      holePrefix = holePrefixFor ctx nm+    }+  where+    spec = checkedSpec service+    nm = (.name) agg+    typeGraphResult = checkedTypeGraph service+    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec+    ctxPascal = pascalFromKebab ((.name) ctx)+    vertexType = nm <> "Vertex"+    commandFieldTypes = [((.name) c, (.fields) c) | c <- (.commands) agg]+    resolveCommand c = mkCtor CommandFieldUse ((.name) c) ((.fields) c) 1 Nothing+    resolveEvent e =+      mkCtor EventFieldUse ((.name) e) (eventFields e) ((.version) e) (fst <$> (.upcastFrom) e)+      where+        eventFields ev = case (.body) ev of+          EventFields fs -> fs+          EventFromCommand cn -> fromMaybe [] (lookup cn commandFieldTypes)+    mkCtor useSite cn fs version upcastFrom =+      ResolvedCtor+        { name = cn,+          fields = map (\field -> (resolveAggregateFieldIdentity field, orDie (inferAggregateFieldType symbols agg useSite field))) fs,+          version,+          upcastFrom+        }+    aggregateResolvedTypes =+      map (.valueType) (map resolveRegister ((.regs) agg))+        <> map snd (concatMap (.fields) (map resolveCommand ((.commands) agg)))+        <> map snd (concatMap (.fields) (map resolveEvent ((.events) agg)))+    resolvedDomainOutcomeTypes = case (.domainOutcomeTypes) agg of+      Nothing -> Nothing+      Just declaration ->+        Just+          ResolvedDomainOutcomeTypes+            { rejectionType = resolveOutcomeType declaration ((.rejectionType) declaration),+              noOpType = resolveOutcomeType declaration ((.noOpType) declaration)+            }+    resolveOutcomeType declaration name =+      orDie (resolveAggregateType symbols ((.outcomeTypesLoc) declaration) HaskellLoweringUse (TRef name))+    resolveRegister register =+      let resolvedType = orDie (resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register))+          resolvedInitial = orDie (resolveRegisterInitial symbols ((.loc) register) resolvedType ((.initial) register))+       in ResolvedRegister+            { name = (.name) register,+              valueType = resolvedType,+              initial = resolvedInitial,+              loc = (.loc) register+            }+    orDie = either (error . ("validated aggregate resolution failed: " <>) . show) id+    orDieOutput = either (error . ("validated aggregate output resolution failed: " <>) . show) id++-- | Keep only generated nominal IDs/enums from a resolved aggregate type list.+-- The map both deduplicates and makes declaration/import order independent of+-- member and field order.+generatedNominalsInTypes :: [ResolvedAggregateType] -> [ResolvedNominalType]+generatedNominalsInTypes resolvedTypes =+  Map.elems . Map.fromList $+    [ ((.name) nominal, nominal)+    | AggregateNominal nominal <- resolvedTypes,+      GeneratedNominal <- [(.ownership) nominal]+    ]++-- | Plan declaration ownership and use closure without emitting text. Parsing+-- and validation already reject malformed declarations; retaining the checked+-- error here keeps this function total for direct library callers.+planNominalGeneration :: Context -> Spec -> Either (NonEmpty NominalTypeError) [NominalGenerationOwner]+planNominalGeneration ctx spec = planNominalGenerationForService ctx (legacyCheckedService spec)++planNominalGenerationForService :: Context -> CheckedService -> Either (NonEmpty NominalTypeError) [NominalGenerationOwner]+planNominalGenerationForService ctx service = do+  registry <- resolveNominalTypes spec+  let aggregates = [resolveAggForService ctx service aggregate | NAggregate aggregate <- (.nodes) spec]+      generated =+        [ nominal+        | nominal <- Map.elems (nominalTypes registry),+          GeneratedNominal <- [(.ownership) nominal]+        ]+  pure+    [ NominalGenerationOwner+        { declaration = nominal,+          moduleName = generatedNominalModule ctx,+          useSites = Set.fromList (concatMap (usesFor nominal) aggregates),+          equalityUsed = any (nominalEqualityUsedInGeneratedExpressions nominal) aggregates+        }+    | nominal <- generated+    ]+  where+    spec = checkedSpec service+    usesFor nominal aggregate =+      [ NominalUseSite ((.name) aggregate) useKind+      | useKind <- aggregateUseKinds nominal aggregate+      ]++nominalEqualityUsedInGeneratedExpressions :: ResolvedNominalType -> Agg -> Bool+nominalEqualityUsedInGeneratedExpressions nominal aggregate =+  any+    (anyTypedExpression comparesNominal)+    (resolvedGeneratedExpressions aggregate <> resolvedOutcomeExpressions aggregate)+  where+    comparesNominal expression = case (.node) expression of+      TypedEqual left _ -> (.valueType) left == AggregateNominal nominal+      TypedNotEqual left _ -> (.valueType) left == AggregateNominal nominal+      _ -> False++aggregateUseKinds :: ResolvedNominalType -> Agg -> [AggregateUseSite]+aggregateUseKinds nominal aggregate =+  nub $+    [RegisterUse | nominal `elem` registerNominals]+      <> [CommandFieldUse | nominal `elem` commandNominals]+      <> [EventFieldUse | nominal `elem` eventNominals]+      <> [CodecUse | nominal `elem` eventNominals]+      <> [SnapshotUse | hasSnapshot aggregate && nominal `elem` registerNominals]+      <> [HarnessSampleUse | nominal `elem` commandNominals || nominal `elem` eventNominals]+      <> [HaskellLoweringUse | nominal `elem` ((.generatedNominals) aggregate <> outcomeNominals)]+  where+    registerNominals = generatedNominalsInTypes (map (.valueType) ((.regs) aggregate))+    commandNominals = generatedNominalsInTypes (map snd (concatMap (.fields) ((.commands) aggregate)))+    eventNominals = generatedNominalsInTypes (map snd (concatMap (.fields) ((.events) aggregate)))+    outcomeNominals =+      generatedNominalsInTypes+        [ resolvedType+        | outcomeTypes <- maybeToList ((.domainOutcomeTypes) aggregate),+          resolvedType <- [(.rejectionType) outcomeTypes, (.noOpType) outcomeTypes]+        ]++--------------------------------------------------------------------------------+-- Entry point+--------------------------------------------------------------------------------++-- | Emit the context-level private structural stratum. Shape modules contain+-- only generated wire representations. The projection facade contains only+-- schema-derived Keiki field witnesses; neither layer owns consumer behavior.+scaffoldStructural :: Context -> Spec -> [ScaffoldModule]+scaffoldStructural ctx spec = scaffoldStructuralForService ctx (legacyCheckedService spec)++scaffoldStructuralForService :: Context -> CheckedService -> [ScaffoldModule]+scaffoldStructuralForService ctx service = map fst (scaffoldStructuralOwnersForService ctx service)++-- | 'scaffoldStructural' paired with the mapped declarations each module was+-- emitted for. A shape module names exactly one declaration; a binding skeleton+-- names every declaration whose obligations it carries (several declarations may+-- share one leaf binding module); the projection facade names __none__, because it+-- is emitted once for the whole context from the complete resolved graph.+--+-- This is the attribution seam whole-workspace scaffolding needs: a workspace+-- emits from one merged spec, and this list says which declaration — and therefore+-- which member file — produced each structural module, without parsing the+-- human-readable 'origin' string.+scaffoldStructuralOwners :: Context -> Spec -> [(ScaffoldModule, [Name])]+scaffoldStructuralOwners ctx spec = scaffoldStructuralOwnersForService ctx (legacyCheckedService spec)++scaffoldStructuralOwnersForService :: Context -> CheckedService -> [(ScaffoldModule, [Name])]+scaffoldStructuralOwnersForService ctx service = case checkedTypeGraph service of+  Left _ -> []+  Right graph ->+    [(shapeModule ctx graph entry, [(.name) (fst entry)]) | entry <- structural]+      <> projectionModules+      <> generatedNominalOwners ctx service+      <> nominalRepresentationOwners ctx spec+      <> nominalProjectionOwners ctx service+      <> bindingSkeletonOwnersForService ctx service graph+    where+      structural =+        [ (declaration, shape)+        | ResolvedStructural declaration shape <- Map.elems ((.declarations) graph)+        ]+      projectionModules =+        [ ( ScaffoldModule+              { path = T.unpack (T.replace "." "/" (structuralProjectionModule ctx) <> ".hs"),+                text = emitStructuralProjections ctx graph,+                kind = Generated,+                origin = "context " <> (.context) spec <> " mapped structural facade"+              },+            []+          )+        | not (null (projectionSpecs graph))+        ]+      spec = checkedSpec service++-- | Plan one opt-in, non-production historical-codec comparison module.+--+-- The module is intentionally absent from 'scaffoldStructural' and therefore+-- from production manifests and scaffold records. It must be requested by name+-- and is compiled only by consumer-owned test/tool components.+codecComparisonModule :: Context -> Spec -> Name -> Either Text ScaffoldModule+codecComparisonModule ctx spec requestedName = do+  graph <- either (Left . ("mapped type graph did not resolve: " <>) . T.pack . show) Right (resolveTypeGraph spec)+  (declaration, shape) <- case Map.lookup (MappedKey requestedName) ((.declarations) graph) of+    Nothing -> Left ("codec comparison target is not a mapped declaration: " <> requestedName)+    Just (ResolvedOpaque _) ->+      Left+        ( "codec comparison target "+            <> requestedName+            <> " is opaque; finite evidence must never upgrade an opaque declaration to a structural claim"+        )+    Just (ResolvedStructural declaration shape) -> Right (declaration, shape)+  owner <- case sortOn (.name) (comparisonOwners declaration) of+    [] ->+      Left+        ( "codec comparison target "+            <> requestedName+            <> " is not reachable from a persisted private event payload"+        )+    aggregate : _ -> Right aggregate+  let moduleName = structuralPrefix ctx <> ".CodecCompare." <> requestedName+  pure+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+        text = emitCodecComparison ctx moduleName graph declaration shape owner,+        kind = Generated,+        origin = "non-production codec comparison " <> requestedName+      }+  where+    comparisonOwners declaration =+      [ aggregate+      | NAggregate aggregate <- (.nodes) spec,+        let resolved = resolveAgg ctx spec aggregate,+        any ((== (.name) declaration) . mappedName) (codecMappedDeclarations resolved)+      ]+      where+        mappedName (ResolvedStructural structural _) = (.name) structural+        mappedName (ResolvedOpaque opaque) = (.name) opaque++codecComparisonBanner :: Text+codecComparisonBanner =+  "-- @generated by keiro-dsl codec comparison; non-production migration evidence; do not edit."++emitCodecComparison :: Context -> Text -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Aggregate -> Text+emitCodecComparison ctx moduleName graph declaration shape owner =+  nl+    [ "",+      codecComparisonBanner,+      "-- This module compares historical and generated codecs in consumer-owned tests only.",+      "-- It is never a runtime fallback and never changes the generated codec's authority.",+      "module " <> moduleName <> " (compareWithHistorical) where",+      "",+      "import Control.Monad (filterM)",+      "import Data.Aeson (Value)",+      "import Data.Aeson qualified as Aeson",+      "import Data.List (sort)",+      "import Data.List.NonEmpty qualified as NonEmpty",+      "import Data.Text (Text)",+      "import Data.Text qualified",+      "import " <> codecModule <> " qualified as GeneratedCodec",+      "import Keiro.Codec.Structural (FixtureCases (..))",+      "import Keiro.Dsl.CodecCompare",+      "import Keiro.Dsl.TypeGraph (BindingVersion (..), CanonicalTypeId (..), QualifiedValueName (..))",+      "import System.Directory (doesFileExist, listDirectory)",+      "import System.FilePath (takeExtension, (</>))",+      renderPlannedImports importPlan,+      "",+      "compareWithHistorical :: HistoricalCodec " <> domainType <> " -> FilePath -> IO CompareReport",+      "compareWithHistorical historicalCodec goldenDirectory = do",+      "  names <- sort . filter ((== \".json\") . takeExtension) <$> listDirectory goldenDirectory",+      "  files <- filterM doesFileExist [goldenDirectory </> name | name <- names]",+      "  loaded <- traverse (loadGolden historicalCodec) files",+      "  let inputIssues = [issue | Left issue <- loaded]",+      "      entries = [entry | Right entry <- loaded]",+      "      typedCases = NonEmpty.toList (fixtureCases " <> fixtureReference <> ")",+      "      encodeObservations =",+      "        [ EncodeObservation label (historicalCodec.encode value) (GeneratedCodec.encode" <> name <> "Mapped value)",+      "        | (label, value) <- typedCases",+      "        ]",+      "      decodeObservations = [observation | (observation, _) <- entries]",+      "      typedObserved =",+      "        concat",+      "          [ observedBranchesFor FromBinding branchSchema (GeneratedCodec.encode" <> name <> "Mapped value)",+      "          | (_, value) <- typedCases",+      "          ]",+      "      historicalObserved =",+      "        concat [observedBranchesFor HistoricalGolden branchSchema value | (_, values) <- entries, value <- values]",+      "      declared = declaredBranchesFor FromBinding branchSchema <> declaredBranchesFor HistoricalGolden branchSchema",+      "      provenance =",+      "        CompareProvenance",+      "          { historicalCodecIdentity = historicalCodec.identity",+      "          , historicalCodecVersion = historicalCodec.version",+      "          , canonicalType = CanonicalTypeId " <> tshow (unCanonicalTypeId ((.canonical) declaration)),+      "          , bindingSymbol = QualifiedValueName " <> tshow (unQualifiedValueName ((.binding) declaration)),+      "          , bindingVersion = BindingVersion " <> tshow (unBindingVersion ((.bindingVersion) declaration)),+      "          , wireFingerprint = " <> tshow (wireFingerprint graph name),+      "          }",+      "  pure (compareReport provenance inputIssues (encodeObservations <> decodeObservations) declared (typedObserved <> historicalObserved))",+      "",+      "loadGolden :: HistoricalCodec " <> domainType <> " -> FilePath -> IO (Either CompareInputIssue (CompareObservation, [Value]))",+      "loadGolden historicalCodec path = do",+      "  decoded <- Aeson.eitherDecodeFileStrict path",+      "  pure $ case decoded of",+      "    Left reason -> Left (HistoricalGoldenUnreadable path (fromString reason))",+      "    Right inputValue ->",+      "      let historicalDecoded = historicalCodec.decode inputValue",+      "          historicalOutcome = normalizeDecode historicalDecoded",+      "          generatedOutcome = normalizeDecode (GeneratedCodec.decode" <> name <> "Mapped inputValue)",+      "          observation = DecodeObservation path inputValue historicalOutcome generatedOutcome",+      "          coveredValues = case historicalDecoded of",+      "            Right value -> [inputValue, GeneratedCodec.encode" <> name <> "Mapped value]",+      "            Left _ -> []",+      "       in Right (observation, coveredValues)",+      "",+      "normalizeDecode :: Either Text " <> domainType <> " -> DecodeOutcome",+      "normalizeDecode = either DecodeFailed (DecodedShape . GeneratedCodec.encode" <> name <> "Mapped)",+      "",+      "fromString :: String -> Text",+      "fromString = Data.Text.pack",+      "",+      "branchSchema :: BranchSchema",+      "branchSchema = " <> renderBranchSchema (branchSchemaFor graph (ResolvedStructural declaration shape))+    ]+  where+    name = (.name) declaration+    domainType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) declaration))+    codecModule = genPrefixFor ctx ((.name) owner) <> ".Codec"+    fixtureReference = renderReferenceOrDie importPlan (qualifiedValueReference ((.fixtures) declaration))+    importPlan =+      planImportsOrDie+        moduleName+        Set.empty+        ( Set.fromList+            [ haskellTypeReference ((.haskell) declaration),+              qualifiedValueReference ((.fixtures) declaration)+            ]+        )++branchSchemaFor :: TypeGraph -> ResolvedMappedDecl -> BranchSchema+branchSchemaFor graph =+  foldMappedDecl+    MappedDeclAlgebra+      { onStructuralDecl = \_ shape ->+          foldMappedShape+            MappedShapeAlgebra+              { onRecord = \_ _ fields ->+                  BranchRecord+                    [ BranchField+                        ((.key) field)+                        ((.presence) field == POptional)+                        (branchExpr graph ((.valueType) field))+                    | field <- fields+                    ],+                onEnum = const BranchScalar,+                onUnion = \encoding arms ->+                  BranchUnion+                    ((.tagField) encoding)+                    ((.contentsField) encoding)+                    [BranchArm ((.tag) arm) (branchExpr graph <$> (.payload) arm) | arm <- arms]+              }+            shape,+        onOpaqueDecl = const BranchScalar+      }++branchExpr :: TypeGraph -> ResolvedTypeExpr -> BranchSchema+branchExpr graph =+  foldTypeExpr+    TypeExprAlgebra+      { onText = BranchScalar,+        onInt = BranchScalar,+        onInteger = BranchScalar,+        onBool = BranchScalar,+        onNatural = BranchScalar,+        onTime = BranchScalar,+        onJson = BranchScalar,+        onOptional = BranchOptional,+        onList = BranchList,+        onMap = BranchMap,+        onRef = \key -> maybe BranchScalar (branchSchemaFor graph) (Map.lookup key ((.declarations) graph))+      }++renderBranchSchema :: BranchSchema -> Text+renderBranchSchema schema = case schema of+  BranchScalar -> "BranchScalar"+  BranchOptional nested -> "BranchOptional (" <> renderBranchSchema nested <> ")"+  BranchList nested -> "BranchList (" <> renderBranchSchema nested <> ")"+  BranchMap nested -> "BranchMap (" <> renderBranchSchema nested <> ")"+  BranchRecord fields ->+    "BranchRecord ["+      <> T.intercalate+        ", "+        [ "BranchField "+            <> tshow ((.wireKey) field)+            <> " "+            <> (if (.presenceOptional) field then "True" else "False")+            <> " ("+            <> renderBranchSchema ((.schema) field)+            <> ")"+        | field <- fields+        ]+      <> "]"+  BranchUnion tagField contentsField arms ->+    "BranchUnion "+      <> tshow tagField+      <> " "+      <> tshow contentsField+      <> " ["+      <> T.intercalate+        ", "+        [ "BranchArm "+            <> tshow ((.wireTag) arm)+            <> " "+            <> maybe "Nothing" (\nested -> "(Just (" <> renderBranchSchema nested <> "))") ((.payloadSchema) arm)+        | arm <- arms+        ]+      <> "]"++-- | Emit one create-once consumer module per distinct qualified obligation+-- owner. Multiple mapped declarations may intentionally share a leaf binding+-- module, so grouping happens by module rather than by declaration.+bindingSkeletonModules :: Context -> Spec -> TypeGraph -> [ScaffoldModule]+bindingSkeletonModules ctx spec graph = map fst (bindingSkeletonOwners ctx spec graph)++-- | 'bindingSkeletonModules' paired with the mapped declarations whose+-- obligations each skeleton carries, in first-appearance order. A skeleton shared+-- by declarations from different member files therefore names all of them, which+-- is what lets whole-workspace scaffolding treat it as context-level rather than+-- attributing it to an arbitrary member.+bindingSkeletonOwners :: Context -> Spec -> TypeGraph -> [(ScaffoldModule, [Name])]+bindingSkeletonOwners ctx spec graph = bindingSkeletonOwnersWithObligations ctx spec graph (bindingObligations spec)++bindingSkeletonOwnersForService :: Context -> CheckedService -> TypeGraph -> [(ScaffoldModule, [Name])]+bindingSkeletonOwnersForService ctx service graph =+  bindingSkeletonOwnersWithObligations ctx (checkedSpec service) graph (bindingObligationsForService service)++bindingSkeletonOwnersWithObligations :: Context -> Spec -> TypeGraph -> Either errors [BindingObligation] -> [(ScaffoldModule, [Name])]+bindingSkeletonOwnersWithObligations ctx spec graph obligationResult = case obligationResult of+  Left _ -> []+  Right obligations ->+    [ (emitBindingSkeleton ctx spec graph owner entries, nub (map (.mappedName) entries))+    | (owner, entries) <- Map.toAscList (Map.fromListWith (<>) [((.moduleName) obligation, [obligation]) | obligation <- obligations])+    ]++emitBindingSkeleton :: Context -> Spec -> TypeGraph -> Text -> [BindingObligation] -> ScaffoldModule+emitBindingSkeleton ctx spec graph owner obligations =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" owner <> ".hs"),+      text =+        nl $+          [ "{-# LANGUAGE DataKinds #-}",+            "{-# LANGUAGE LambdaCase #-}",+            "",+            "-- This is a HAND-OWNED consumer binding skeleton. keiro-dsl creates it once",+            "-- and never overwrites it. Fill each HOLE and run the generated harness.",+            "module " <> owner <> " ("+          ]+            <> exportLines+            <> [") where", ""]+            <> importLines+            <> [""]+            <> intercalateBlank (map renderObligation obligations),+      kind = HoleStub,+      origin = "consumer binding skeleton " <> owner+    }+  where+    exportLines =+      [ (if index == (0 :: Int) then "    " else "  , ") <> (.symbol) obligation+      | (index, obligation) <- zip [0 ..] obligations+      ]+    importPlan = bindingSkeletonImportPlan ctx spec graph owner obligations+    importLines =+      sort . nub $+        map ("import " <>) staticImports+          <> T.lines (renderPlannedImports importPlan)+    staticImports =+      sort . nub $+        [ "Keiro.Codec.Structural (FixtureCases, StructuralBinding (..))"+        | any (\obligation -> (.category) obligation == "structural" && (.kind) obligation `elem` [BindingValue, FixtureValue]) obligations+        ]+          <> [ "Keiro.Codec.Nominal (NominalBinding (..), NominalFixtureCases)"+             | any ((/= "structural") . (.category)) obligations+             ]+          <> [ "Data.KindID (KindID)"+             | obligation <- obligations,+               Just (nominal, _) <- [nominalFor obligation],+               IdRepresentation {} <- [(.representation) nominal]+             ]+          <> [ "Data.Text (Text)"+             | obligation <- obligations,+               Just (nominal, _) <- [nominalFor obligation],+               ScalarRepresentation NominalText <- [(.representation) nominal]+             ]+          <> [ "Data.Time (UTCTime)"+             | obligation <- obligations,+               Just (nominal, _) <- [nominalFor obligation],+               ScalarRepresentation NominalTime <- [(.representation) nominal]+             ]+          <> [ "Numeric.Natural (Natural)"+             | obligation <- obligations,+               Just (nominal, _) <- [nominalFor obligation],+               ScalarRepresentation NominalNatural <- [(.representation) nominal]+             ]+    renderObligation obligation = case structuralFor obligation of+      Nothing -> case nominalFor obligation of+        Just (nominal, binding) -> renderNominalObligation nominal binding obligation+        Nothing -> ["-- HOLE: declaration disappeared before skeleton rendering"]+      Just (declaration, shape) -> case (.kind) obligation of+        BindingValue -> renderBinding importPlan ctx declaration shape obligation+        FixtureValue ->+          [ "-- HOLE: provide deterministic labelled conformance fixtures for " <> (.name) declaration,+            renderStructuralObligationSignature importPlan declaration obligation,+            (.symbol) obligation <> " = error " <> tshow ("HOLE: fill " <> (.name) declaration <> " fixtures")+          ]+        InitialValue ->+          [ "-- HOLE: provide the initial register value for " <> (.name) declaration,+            renderStructuralObligationSignature importPlan declaration obligation,+            (.symbol) obligation <> " = error " <> tshow ("HOLE: fill " <> (.name) declaration <> " initial value")+          ]+    structuralFor obligation = case Map.lookup (MappedKey ((.mappedName) obligation)) ((.declarations) graph) of+      Just (ResolvedStructural declaration shape) -> Just (declaration, shape)+      _ -> Nothing+    nominalFor obligation = do+      registry <- either (const Nothing) Just (resolveNominalTypes spec)+      nominal <- lookupNominalType ((.mappedName) obligation) registry+      binding <- case (.ownership) nominal of+        ConsumerNominal value -> Just value+        GeneratedNominal -> Nothing+      pure (nominal, binding)+    renderNominalObligation nominal binding obligation = case (.kind) obligation of+      BindingValue ->+        [ "-- HOLE: complete both total directions; the generated codec remains wire authority.",+          renderNominalObligationSignature importPlan ctx nominal binding obligation,+          (.symbol) obligation <> " =",+          "  NominalBinding",+          "    { nominalToRepresentation = \\_domainValue -> error " <> tshow ("HOLE: fill " <> (.name) nominal <> " nominalToRepresentation"),+          "    , nominalFromRepresentation = \\_representationValue -> error " <> tshow ("HOLE: fill " <> (.name) nominal <> " nominalFromRepresentation"),+          "    }"+        ]+      FixtureValue ->+        [ "-- HOLE: provide deterministic labelled expected-wire fixtures for " <> (.name) nominal,+          renderNominalObligationSignature importPlan ctx nominal binding obligation,+          (.symbol) obligation <> " = error " <> tshow ("HOLE: fill " <> (.name) nominal <> " fixtures")+        ]+      InitialValue ->+        [ "-- HOLE: provide the initial register value for " <> (.name) nominal,+          renderNominalObligationSignature importPlan ctx nominal binding obligation,+          (.symbol) obligation <> " = error " <> tshow ("HOLE: fill " <> (.name) nominal <> " initial value")+        ]+    intercalateBlank [] = []+    intercalateBlank (section : rest) = section <> concatMap ("" :) rest++renderBinding :: HaskellImportPlan -> Context -> StructuralDecl -> ResolvedMappedShape -> BindingObligation -> [Text]+renderBinding importPlan ctx declaration shape obligation =+  [ "-- HOLE: complete both total directions; wire policy remains in the generated codec.",+    (.symbol) obligation <> " :: StructuralBinding " <> domainType <> " " <> shapeType,+    (.symbol) obligation <> " =",+    "  StructuralBinding",+    "    { bindingToShape = \\case"+  ]+    <> indentCases (bindingCases True)+    <> ["    , bindingFromShape = \\case"]+    <> indentCases (bindingCases False)+    <> ["    }"]+  where+    domainType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) declaration))+    shapeModuleName = structuralShapeModule ctx ((.name) declaration)+    shapeType = renderReferenceOrDie importPlan (qualifiedTypeReference shapeModuleName ((.name) declaration <> "Shape"))+    domainCtor constructor = renderReferenceOrDie importPlan (constructorReference ((.moduleName) ((.haskell) declaration)) constructor)+    shapeCtor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)+    indentCases = map ("      " <>)+    bindingCases toShapeDirection =+      foldMappedShape+        MappedShapeAlgebra+          { onRecord = \constructor _ fields -> [recordCase toShapeDirection constructor fields],+            onEnum = \entries -> map (enumCase toShapeDirection . (.ctor)) entries,+            onUnion = \_ arms -> map (unionCase toShapeDirection) arms+          }+        shape+    recordCase toShapeDirection constructor fields =+      sourceCtor+        <> arguments variables+        <> " -> "+        <> targetCtor+        <> arguments (map (holeFor toShapeDirection . (.haskell)) fields)+      where+        variables = map (("_" <>) . (<> "Value") . (.haskell)) fields+        sourceCtor = if toShapeDirection then domainCtor constructor else shapeCtor constructor+        targetCtor = if toShapeDirection then shapeCtor constructor else domainCtor constructor+    enumCase toShapeDirection constructor =+      sourceCtor <> " -> " <> holeFor toShapeDirection constructor+      where+        sourceCtor = if toShapeDirection then domainCtor constructor else shapeCtor constructor+    unionCase toShapeDirection arm =+      sourceCtor+        <> maybe "" (const " _payloadValue") ((.payload) arm)+        <> " -> "+        <> case (.payload) arm of+          Nothing -> holeFor toShapeDirection ((.ctor) arm)+          Just _ -> targetCtor <> " " <> holeFor toShapeDirection ((.ctor) arm <> ".payload")+      where+        sourceCtor = if toShapeDirection then domainCtor ((.ctor) arm) else shapeCtor ((.ctor) arm)+        targetCtor = if toShapeDirection then shapeCtor ((.ctor) arm) else domainCtor ((.ctor) arm)+    arguments [] = ""+    arguments values = " " <> T.unwords values+    holeFor toShapeDirection name =+      "(error "+        <> tshow+          ( "HOLE: fill "+              <> (.name) declaration+              <> (if toShapeDirection then " bindingToShape." else " bindingFromShape.")+              <> name+          )+        <> ")"++bindingSkeletonImportPlan :: Context -> Spec -> TypeGraph -> Text -> [BindingObligation] -> HaskellImportPlan+bindingSkeletonImportPlan ctx spec graph owner obligations =+  planImportsOrDie owner (Set.fromList (map (.symbol) obligations)) (Set.fromList (concatMap obligationReferences obligations))+  where+    obligationReferences obligation = case Map.lookup (MappedKey ((.mappedName) obligation)) ((.declarations) graph) of+      Just (ResolvedStructural declaration shape) ->+        haskellTypeReference ((.haskell) declaration)+          : [ qualifiedTypeReference shapeModuleName ((.name) declaration <> "Shape")+            | (.kind) obligation == BindingValue+            ]+            <> [ reference+               | (.kind) obligation == BindingValue,+                 constructor <- structuralConstructorNames shape,+                 reference <-+                   [ constructorReference ((.moduleName) ((.haskell) declaration)) constructor,+                     constructorReference shapeModuleName constructor+                   ]+               ]+        where+          shapeModuleName = structuralShapeModule ctx ((.name) declaration)+      _ -> case nominalForName ((.mappedName) obligation) of+        Just (nominal, binding) ->+          haskellTypeReference ((.haskell) binding)+            : [ qualifiedTypeReference+                  (nominalRepresentationModule ctx ((.name) nominal))+                  ((.name) nominal <> "Representation")+              | (.kind) obligation == BindingValue,+                EnumRepresentation {} <- [(.representation) nominal]+              ]+        Nothing -> []+    nominalForName name = do+      registry <- either (const Nothing) Just (resolveNominalTypes spec)+      nominal <- lookupNominalType name registry+      binding <- case (.ownership) nominal of+        ConsumerNominal value -> Just value+        GeneratedNominal -> Nothing+      pure (nominal, binding)++structuralConstructorNames :: ResolvedMappedShape -> [Text]+structuralConstructorNames =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \constructor _ _ -> [constructor],+        onEnum = map (.ctor),+        onUnion = \_ -> map (.ctor)+      }++structuralShapeReferences :: Context -> StructuralDecl -> ResolvedMappedShape -> [HaskellReference]+structuralShapeReferences ctx declaration shape =+  qualifiedTypeReference moduleName ((.name) declaration <> "Shape")+    : [constructorReference moduleName constructor | constructor <- structuralConstructorNames shape]+      <> [ HaskellReference moduleName selector ValueNamespace RequireQualified+         | selector <- structuralSelectorNames shape+         ]+  where+    moduleName = structuralShapeModule ctx ((.name) declaration)++structuralSelectorNames :: ResolvedMappedShape -> [Text]+structuralSelectorNames =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \_ _ -> map (.haskell),+        onEnum = const [],+        onUnion = \_ _ -> []+      }++nominalRepresentationEncoderReference :: Context -> ResolvedNominalType -> HaskellReference+nominalRepresentationEncoderReference ctx nominal =+  HaskellReference+    (nominalRepresentationModule ctx name)+    (lowerFirst name <> "RepresentationText")+    ValueNamespace+    RequireQualified+  where+    name = (.name) nominal++nominalRepresentationConstructorReference :: Context -> ResolvedNominalType -> Text -> HaskellReference+nominalRepresentationConstructorReference ctx nominal constructor =+  HaskellReference+    (nominalRepresentationModule ctx ((.name) nominal))+    constructor+    ConstructorNamespace+    RequireQualified++renderStructuralObligationSignature :: HaskellImportPlan -> StructuralDecl -> BindingObligation -> Text+renderStructuralObligationSignature importPlan declaration obligation =+  (.symbol) obligation+    <> " :: "+    <> case (.kind) obligation of+      BindingValue -> error "structural binding signatures are rendered with renderBinding"+      FixtureValue -> "FixtureCases " <> domainType+      InitialValue -> domainType+  where+    domainType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) declaration))++renderNominalObligationSignature :: HaskellImportPlan -> Context -> ResolvedNominalType -> ConsumerNominalBinding -> BindingObligation -> Text+renderNominalObligationSignature importPlan ctx nominal binding obligation =+  (.symbol) obligation+    <> " :: "+    <> case (.kind) obligation of+      BindingValue -> "NominalBinding " <> domainType <> " " <> representationType+      FixtureValue -> "NominalFixtureCases " <> domainType+      InitialValue -> domainType+  where+    domainType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding))+    representationType = case (.representation) nominal of+      IdRepresentation prefix -> "(KindID " <> tshow prefix <> ")"+      EnumRepresentation {} ->+        renderReferenceOrDie+          importPlan+          ( qualifiedTypeReference+              (nominalRepresentationModule ctx ((.name) nominal))+              ((.name) nominal <> "Representation")+          )+      ScalarRepresentation NominalText -> "Text"+      ScalarRepresentation NominalInt -> "Int"+      ScalarRepresentation NominalNatural -> "Natural"+      ScalarRepresentation NominalBool -> "Bool"+      ScalarRepresentation NominalTime -> "UTCTime"++qualifiedTypeReference :: Text -> Text -> HaskellReference+qualifiedTypeReference moduleName typeName =+  HaskellReference moduleName typeName TypeNamespace RequireQualified++constructorReference :: Text -> Text -> HaskellReference+constructorReference moduleName constructor =+  HaskellReference moduleName constructor ConstructorNamespace RequireQualified++shapeModule :: Context -> TypeGraph -> (StructuralDecl, ResolvedMappedShape) -> ScaffoldModule+shapeModule ctx graph (declaration, shape) =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" (structuralShapeModule ctx ((.name) declaration)) <> ".hs"),+      text = emitShape ctx graph declaration shape,+      kind = Generated,+      origin = nodeOrigin "mapped structural" ((.name) declaration) ((.loc) declaration)+    }++structuralPrefix :: Context -> Text+structuralPrefix ctx = case (.placement) ctx of+  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".Structural"+  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated.Structural"++structuralShapeModule :: Context -> Name -> Text+structuralShapeModule ctx name = structuralPrefix ctx <> ".Shape." <> name++nominalRepresentationModule :: Context -> Name -> Text+nominalRepresentationModule ctx name = case (.placement) ctx of+  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".Nominal.Shape." <> name+  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Nominal.Shape." <> name <> ".Generated"++-- | Emit the one generated nominal authority for the complete context. The+-- empty declaration attribution is intentional: in a workspace this module is+-- context-level even when all declarations currently happen to live in one+-- member, so moving that member cannot move Haskell type ownership.+generatedNominalOwners :: Context -> CheckedService -> [(ScaffoldModule, [Name])]+generatedNominalOwners ctx service = case planNominalGenerationForService ctx service of+  Left _ -> []+  Right [] -> []+  Right owners ->+    [ ( ScaffoldModule+          { path = T.unpack (T.replace "." "/" (generatedNominalModule ctx) <> ".hs"),+            text = emitGeneratedNominals languageContract ctx owners,+            kind = Generated,+            origin = "context " <> (.context) spec <> " generated nominal declarations"+          },+        []+      )+    ]+      <> [ ( ScaffoldModule+               { path = T.unpack (T.replace "." "/" (generatedNominalInternalModule ctx) <> ".hs"),+                 text = emitGeneratedNominalInternals ctx enforcingIds,+                 kind = Generated,+                 origin = "context " <> (.context) spec <> " generated nominal ID internals"+               },+             []+           )+         | not (null enforcingIds)+         ]+    where+      enforcingIds =+        [ (nominal, contract)+        | owner <- owners,+          let nominal = (.declaration) owner,+          IdRepresentation prefix <- [(.representation) nominal],+          Just contract <- [idDomainContractFor languageContract prefix]+        ]+  where+    spec = checkedSpec service+    languageContract = checkedLanguageContract service++generatedNominalInternalModule :: Context -> Text+generatedNominalInternalModule ctx = generatedNominalModule ctx <> ".Internal"++emitGeneratedNominals :: EffectiveLanguageContract -> Context -> [NominalGenerationOwner] -> Text+emitGeneratedNominals languageContract ctx owners =+  nl+    ( renderGeneratedLanguagePragmas localExtensions+        <> [ generatedBanner,+             moduleHeader,+             ""+           ]+        <> baseImports+        <> internalImports+        <> equalityImports+        <> if T.null declarations then [] else ["", declarations]+    )+  where+    usesEquality = any (.equalityUsed) owners+    exactEqualityOwners = [owner | owner <- owners, (.equalityUsed) owner, exactOwner ((.declaration) owner)]+    inexactEqualityOwners = [owner | owner <- owners, (.equalityUsed) owner, not (exactOwner ((.declaration) owner))]+    usesExactEquality = not (null exactEqualityOwners)+    usesInexactEquality = not (null inexactEqualityOwners)+    legacyNominals =+      [ nominal+      | owner <- owners,+        let nominal = (.declaration) owner,+        case (.representation) nominal of+          IdRepresentation prefix -> not (isJust (idDomainContractFor languageContract prefix))+          EnumRepresentation {} -> True+          ScalarRepresentation {} -> False+      ]+    hasExactEnum = any (\owner -> case (.representation) ((.declaration) owner) of EnumRepresentation {} -> True; _ -> False) exactEqualityOwners+    hasExactEnforcedId = any (\owner -> case (.representation) ((.declaration) owner) of IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix); _ -> False) exactEqualityOwners+    enforcingIds =+      [ nominal+      | owner <- owners,+        let nominal = (.declaration) owner,+        IdRepresentation prefix <- [(.representation) nominal],+        Just _ <- [idDomainContractFor languageContract prefix]+      ]+    moduleHeader+      | null enforcingIds = "module " <> generatedNominalModule ctx <> " where"+      | otherwise =+          nl+            [ "module " <> generatedNominalModule ctx,+              "  ( " <> T.intercalate "\n  , " (concatMap ownerExports owners),+              "  ) where"+            ]+    ownerExports owner =+      baseExports <> equalityExports+      where+        nominal = (.declaration) owner+        name = (.name) nominal+        baseExports = case (.representation) nominal of+          IdRepresentation prefix+            | Just _ <- idDomainContractFor languageContract prefix ->+                [name, "parse" <> name, "mk" <> name, nominalTextName nominal]+          _ -> [name <> " (..)", nominalTextName nominal]+        equalityExports =+          if (.equalityUsed) owner+            then [nominalEqualityTagName nominal, nominalEqualityWitnessName nominal]+            else []+    localExtensions =+      [ExtDeriveAnyClass | any (nominalUsesDeriveAnyClass . (.declaration)) owners]+        <> [ExtTypeFamilies | usesEquality]+    baseImports =+      ["import Data.Aeson (FromJSON, ToJSON)" | not (null legacyNominals)]+        <> ["import Data.Text (Text)" | not (null legacyNominals) || usesEquality]+        <> ["import GHC.Generics (Generic)" | not (null legacyNominals)]+        <> ["import Keiki.Shape (CanonicalTypeName)" | not (null legacyNominals)]+    equalityImports =+      [ "import Keiki.Core (" <> T.intercalate ", " coreImports <> ")"+      | usesEquality+      ]+        <> ["import Data.List.NonEmpty (NonEmpty (..))" | hasExactEnum]+        <> [ "import Keiki.ProjectionDomain (" <> T.intercalate ", " projectionDomainImports <> ")"+           | not (null projectionDomainImports)+           ]+        <> ["import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain)" | hasExactEnforcedId]+      where+        coreImports =+          ["FieldProjection (..)", "FieldWitness"]+            <> (if usesExactEquality then ["ExactFieldProjection (..)", "exactFieldWitness"] else [])+            <> ["fieldWitness" | usesInexactEquality]+        projectionDomainImports =+          ["finiteProjectionDomain" | hasExactEnum]+            <> (if hasExactEnforcedId then ["TextPattern", "textProjectionDomain"] else [])+    internalImports =+      [ "import "+          <> generatedNominalInternalModule ctx+          <> " ("+          <> T.intercalate+            ", "+            (concatMap (\nominal -> [(.name) nominal, "mk" <> (.name) nominal, "parse" <> (.name) nominal, nominalTextName nominal]) enforcingIds)+          <> ")"+      | not (null enforcingIds)+      ]+    declarations = T.dropWhileEnd (== '\n') (sectionsOf [map emitOwner owners])+    emitOwner owner = emitGeneratedNominal languageContract ((.equalityUsed) owner) ((.declaration) owner)+    exactOwner nominal = case (.representation) nominal of+      EnumRepresentation {} -> True+      IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix)+      ScalarRepresentation {} -> False+    nominalUsesDeriveAnyClass nominal = case (.representation) nominal of+      IdRepresentation prefix -> not (isJust (idDomainContractFor languageContract prefix))+      EnumRepresentation {} -> True+      ScalarRepresentation {} -> False++emitGeneratedNominal :: EffectiveLanguageContract -> Bool -> ResolvedNominalType -> Text+emitGeneratedNominal languageContract equalityUsed nominal = case (.representation) nominal of+  IdRepresentation prefix+    | Just _ <- idDomainContractFor languageContract prefix ->+        nl equalitySection+  IdRepresentation {} ->+    nl $+      [ "newtype " <> name <> " = " <> name <> " Text",+        "  deriving stock (Generic, Eq, Ord, Show)",+        "  deriving anyclass (ToJSON, FromJSON)",+        "",+        "instance CanonicalTypeName " <> name,+        "",+        nominalTextName nominal <> " :: " <> name <> " -> Text",+        nominalTextName nominal <> " (" <> name <> " value) = value"+      ]+        <> equalitySection+  EnumRepresentation constructors ->+    nl $+      [ "data " <> name <> " = " <> T.intercalate " | " (map fst (NE.toList constructors)),+        "  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)",+        "  deriving anyclass (ToJSON, FromJSON)",+        "",+        "instance CanonicalTypeName " <> name,+        "",+        nominalTextName nominal <> " :: " <> name <> " -> Text",+        nominalTextName nominal <> " = \\case",+        nl ["  " <> constructor <> " -> " <> tshow wire | (constructor, wire) <- NE.toList constructors]+      ]+        <> equalitySection+  ScalarRepresentation {} ->+    error "generated nominal scalar reached generated declaration emission"+  where+    name = (.name) nominal+    equalitySection = if equalityUsed then ["", emitGeneratedNominalEquality languageContract nominal] else []++emitGeneratedNominalEquality :: EffectiveLanguageContract -> ResolvedNominalType -> Text+emitGeneratedNominalEquality languageContract nominal =+  nl $+    [ "data " <> tagName,+      "",+      "instance FieldProjection " <> tagName <> " where",+      "  type FieldName " <> tagName <> " = " <> tshow name,+      "  type FieldOwner " <> tagName <> " = " <> name,+      "  type FieldResult " <> tagName <> " = Text",+      "  fieldShapeId _ = " <> tshow equalityIdentity,+      "  projectFieldValue _ = " <> nominalTextName nominal+    ]+      <> exactInstance+      <> [ "",+           witnessName <> " :: FieldWitness " <> tagName,+           witnessName <> " = " <> witnessConstructor <> " @" <> tagName+         ]+  where+    name = (.name) nominal+    tagName = nominalEqualityTagName nominal+    witnessName = nominalEqualityWitnessName nominal+    equalityIdentity = fromMaybe (error "generated nominal equality contract missing") (nominalEqualityIdentityForService languageContract nominal)+    (exactInstance, witnessConstructor) = case (.representation) nominal of+      IdRepresentation prefix -> case idDomainContractFor languageContract prefix of+        Nothing -> ([], "fieldWitness")+        Just _ ->+          ( [ "",+              patternName <> " :: TextPattern",+              patternName <> " = either (error . show) id (idDomainTextPattern (typeIdV7Domain " <> tshow prefix <> "))",+              "",+              "instance ExactFieldProjection " <> tagName <> " where",+              "  fieldProjectionDomain _ = textProjectionDomain " <> patternName,+              "  reconstructFieldOwner _ = either (const Nothing) Just . parse" <> name+            ],+            "exactFieldWitness"+          )+      EnumRepresentation constructors ->+        ( [ "",+            "instance ExactFieldProjection " <> tagName <> " where",+            "  fieldProjectionDomain _ = finiteProjectionDomain (" <> renderNonEmpty (map (tshow . snd) (NE.toList constructors)) <> ")",+            "  reconstructFieldOwner _ = \\case"+          ]+            <> ["    " <> tshow wire <> " -> Just " <> constructor | (constructor, wire) <- NE.toList constructors]+            <> ["    _ -> Nothing"],+          "exactFieldWitness"+        )+      ScalarRepresentation {} -> error "generated nominal scalar equality emission"+    patternName = lowerFirst name <> "IdDomainPattern"++emitGeneratedNominalInternals :: Context -> [(ResolvedNominalType, IdDomainContract)] -> Text+emitGeneratedNominalInternals ctx nominals =+  nl+    [ generatedBanner,+      "module " <> generatedNominalInternalModule ctx,+      "  ( " <> T.intercalate "\n  , " (concatMap exportsFor nominals),+      "  ) where",+      "",+      "import Data.Aeson (FromJSON (..), ToJSON (..), withText)",+      "import Data.Text (Text)",+      "import Data.Text qualified as T",+      "import GHC.Generics (Generic)",+      "import Keiki.Shape (CanonicalTypeName)",+      "import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)",+      "",+      sectionsOf [map emitInternal nominals]+    ]+  where+    exportsFor (nominal, _) =+      [ (.name) nominal,+        "parse" <> (.name) nominal,+        "mk" <> (.name) nominal,+        nominalTextName nominal,+        legacyNominalConstructorName nominal+      ]+    emitInternal (nominal, contract) =+      nl+        [ "newtype " <> name <> " = " <> name <> " Text",+          "  deriving stock (Generic, Eq, Ord, Show)",+          "",+          "instance CanonicalTypeName " <> name,+          "",+          "instance ToJSON " <> name <> " where",+          "  toJSON = toJSON . " <> textName,+          "",+          "instance FromJSON " <> name <> " where",+          "  parseJSON = withText " <> tshow name <> " (either (fail . T.unpack) pure . parse" <> name <> ")",+          "",+          "parse" <> name <> " :: Text -> Either Text " <> name,+          "parse" <> name <> " input = case validateIdDomainText (typeIdV7Domain " <> tshow (idDomainPrefix contract) <> ") input of",+          "  Left reason -> Left (T.pack (show reason))",+          "  Right () -> Right (" <> name <> " input)",+          "",+          "mk" <> name <> " :: Text -> Either Text " <> name,+          "mk" <> name <> " = parse" <> name,+          "",+          textName <> " :: " <> name <> " -> Text",+          textName <> " (" <> name <> " value) = value",+          "",+          legacyNominalConstructorName nominal <> " :: Text -> " <> name,+          legacyNominalConstructorName nominal <> " = " <> name+        ]+      where+        name = (.name) nominal+        textName = nominalTextName nominal++nominalEqualityTagName :: ResolvedNominalType -> Text+nominalEqualityTagName nominal = (.name) nominal <> "EqualityProjection"++nominalEqualityWitnessName :: ResolvedNominalType -> Text+nominalEqualityWitnessName nominal = lowerFirst ((.name) nominal) <> "EqualityWitness"++renderNonEmpty :: [Text] -> Text+renderNonEmpty values = case values of+  [] -> error "cannot render an empty exact projection domain"+  firstValue : rest -> firstValue <> " :| [" <> T.intercalate ", " rest <> "]"++nominalTextName :: ResolvedNominalType -> Text+nominalTextName = (<> "Text") . lowerFirst . (.name)++-- | Explicit type/constructor imports for exactly the generated declarations a+-- generated aggregate module uses. Keeping an import list avoids making every+-- aggregate depend on every service declaration merely because they share the+-- one owner module.+generatedNominalTypeImports :: Context -> [ResolvedNominalType] -> [Text]+generatedNominalTypeImports _ [] = []+generatedNominalTypeImports ctx nominals =+  [ "import "+      <> generatedNominalModule ctx+      <> " ("+      <> T.intercalate ", " [(.name) nominal <> " (..)" | nominal <- stableNominals nominals]+      <> ")"+  ]++generatedNominalTypeImportsForService :: CheckedService -> Context -> [ResolvedNominalType] -> [Text]+generatedNominalTypeImportsForService service ctx nominals =+  generatedNominalTypeImportsWithParsers service ctx nominals nominals++-- | As 'generatedNominalTypeImportsForService', but importing an enforced ID's+-- @parse\<Name\>@ only for the nominals in @parsing@.+--+-- The parser is emitted only where a literal of that ID is constructed. A module+-- that merely mentions the type — a guard operand, say — needs the type name and+-- nothing else, and importing the parser there is an unused import.+generatedNominalTypeImportsWithParsers :: CheckedService -> Context -> [ResolvedNominalType] -> [ResolvedNominalType] -> [Text]+generatedNominalTypeImportsWithParsers _ _ [] _ = []+generatedNominalTypeImportsWithParsers service ctx nominals parsing =+  [ "import "+      <> generatedNominalModule ctx+      <> " ("+      <> T.intercalate ", " (concatMap importsFor (stableNominals nominals))+      <> ")"+  ]+  where+    parsingNames = map (.name) (stableNominals parsing)+    importsFor nominal = case (.representation) nominal of+      IdRepresentation prefix+        | Just _ <- idDomainContractFor (checkedLanguageContract service) prefix ->+            [(.name) nominal]+              <> ["parse" <> (.name) nominal | (.name) nominal `elem` parsingNames]+      _ -> [(.name) nominal <> " (..)"]++generatedNominalCodecImports :: CheckedService -> Context -> [ResolvedNominalType] -> [Text]+generatedNominalCodecImports _ _ [] = []+generatedNominalCodecImports service ctx nominals =+  [ "import "+      <> generatedNominalModule ctx+      <> " ("+      <> T.intercalate+        ", "+        ( concat+            [ publicImports nominal+            | nominal <- stableNominals nominals+            ]+        )+      <> ")"+  ]+    <> [ "import "+           <> generatedNominalInternalModule ctx+           <> " ("+           <> T.intercalate ", " [legacyNominalConstructorName nominal | nominal <- enforcingIds]+           <> ")"+       | not (null enforcingIds)+       ]+  where+    publicImports nominal = case (.representation) nominal of+      IdRepresentation prefix+        | Just _ <- idDomainContractFor (checkedLanguageContract service) prefix -> [nominalTextName nominal]+      _ -> [(.name) nominal <> " (..)", nominalTextName nominal]+    enforcingIds =+      [ nominal+      | nominal <- stableNominals nominals,+        IdRepresentation prefix <- [(.representation) nominal],+        Just _ <- [idDomainContractFor (checkedLanguageContract service) prefix]+      ]++legacyNominalConstructorName :: ResolvedNominalType -> Text+legacyNominalConstructorName nominal = "unsafe" <> (.name) nominal <> "FromLegacyText"++stableNominals :: [ResolvedNominalType] -> [ResolvedNominalType]+stableNominals = Map.elems . Map.fromList . map (\nominal -> ((.name) nominal, nominal))++nominalRepresentationOwners :: Context -> Spec -> [(ScaffoldModule, [Name])]+nominalRepresentationOwners ctx spec = case resolveNominalTypes spec of+  Left _ -> []+  Right registry ->+    [ (nominalRepresentationModuleValue ctx nominal constructors, [(.name) nominal])+    | nominal <- Map.elems (nominalTypes registry),+      ConsumerNominal {} <- [(.ownership) nominal],+      EnumRepresentation constructors <- [(.representation) nominal]+    ]++nominalRepresentationModuleValue :: Context -> ResolvedNominalType -> NonEmpty (Name, Text) -> ScaffoldModule+nominalRepresentationModuleValue ctx nominal constructors =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+      text =+        nl+          [ generatedBanner,+            "module " <> moduleName <> " (" <> representationType <> " (..), " <> encoderName <> ") where",+            "",+            "import Data.Text (Text)",+            "import GHC.Generics (Generic)",+            "",+            "data " <> representationType <> " = " <> T.intercalate " | " (map fst (NE.toList constructors)),+            "  deriving stock (Eq, Generic, Ord, Show, Enum, Bounded)",+            "",+            encoderName <> " :: " <> representationType <> " -> Text",+            encoderName <> " = \\case",+            nl ["  " <> constructor <> " -> " <> tshow wire | (constructor, wire) <- NE.toList constructors]+          ],+      kind = Generated,+      origin = nodeOrigin "bound nominal enum representation" ((.name) nominal) ((.loc) nominal)+    }+  where+    moduleName = nominalRepresentationModule ctx ((.name) nominal)+    representationType = (.name) nominal <> "Representation"+    encoderName = lowerFirst ((.name) nominal) <> "RepresentationText"++nominalProjectionModule :: Context -> Text+nominalProjectionModule ctx = case (.placement) ctx of+  GeneratedPrefix -> rootPrefix ctx <> "Generated." <> ctxPascalOf ctx <> ".NominalProjections"+  CollocatedLeaf -> rootPrefix ctx <> ctxPascalOf ctx <> ".Generated.NominalProjections"++nominalProjectionOwners :: Context -> CheckedService -> [(ScaffoldModule, [Name])]+nominalProjectionOwners ctx service = case nominalProjectionTypes (checkedTypeGraph service) spec of+  [] -> []+  nominals ->+    [ ( ScaffoldModule+          { path = T.unpack (T.replace "." "/" (nominalProjectionModule ctx) <> ".hs"),+            text = emitNominalProjections (checkedLanguageContract service) ctx nominals,+            kind = Generated,+            origin = "context " <> (.context) spec <> " nominal scalar projection facade"+          },+        []+      )+    ]+  where+    spec = checkedSpec service++nominalProjectionTypes :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [ResolvedNominalType]+nominalProjectionTypes typeGraphResult spec =+  Map.elems . Map.fromList $+    [ ((.name) nominal, nominal)+    | aggregate <- [value | NAggregate value <- (.nodes) spec],+      resolved <- registerTypes aggregate <> commandTypes aggregate,+      AggregateNominal nominal <- [resolved],+      ConsumerNominal {} <- [(.ownership) nominal]+    ]+  where+    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec+    registerTypes aggregate =+      [ resolved+      | register <- (.regs) aggregate,+        Right resolved <- [resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register)]+      ]+    commandTypes aggregate =+      [ resolved+      | command <- (.commands) aggregate,+        field <- (.fields) command,+        Right resolved <- [inferAggregateFieldType symbols aggregate CommandFieldUse field]+      ]++emitNominalProjections :: EffectiveLanguageContract -> Context -> [ResolvedNominalType] -> Text+emitNominalProjections languageContract ctx nominals =+  nl $+    renderGeneratedLanguagePragmas [ExtTypeFamilies]+      <> [ generatedBanner,+           "module " <> moduleName <> " where",+           ""+         ]+      <> map ("import " <>) imports+      <> T.lines (renderPlannedImports importPlan)+      <> [""]+      <> [T.intercalate "\n\n" (map emitNominalProjection nominals)]+  where+    moduleName = nominalProjectionModule ctx+    imports =+      sort . nub $+        [ "Keiki.Core (" <> T.intercalate ", " coreImports <> ")",+          "Keiro.Codec.Nominal (" <> T.intercalate ", " nominalCodecImports <> ")"+        ]+          <> ["Data.KindID qualified as KindID" | any hasId nominals]+          <> ["Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain, validateIdDomainText)" | any hasEnforcedId nominals]+          <> ["Data.List.NonEmpty (NonEmpty (..))" | any hasExactDomain nominals]+          <> ["Data.Text (Text)" | any usesText nominals]+          <> ["Data.Time (UTCTime)" | any (hasScalar NominalTime) nominals]+          -- The four text combinators build the legacy hand-rolled TypeID+          -- pattern and are used only by the unenforced-ID branch; importing+          -- them unconditionally warns under -Wunused-imports whenever every+          -- exact-domain nominal is an enum or an enforced ID.+          <> [ "Keiki.ProjectionDomain ("+                 <> T.intercalate+                   ", "+                   ( ["TextPattern", "finiteProjectionDomain", "matchesTextPattern", "textProjectionDomain"]+                       <> (if any hasUnenforcedId nominals then ["textCharSet", "textConcat", "textLiteral", "textRepeatBetween"] else [])+                   )+                 <> ")"+             | any hasExactDomain nominals+             ]+          <> ["Numeric.Natural (Natural)" | any (hasScalar NominalNatural) nominals]+    hasExactProjection nominal = case (.representation) nominal of ScalarRepresentation {} -> False; _ -> True+    hasInexactProjection = any (not . hasExactProjection) nominals+    hasReconstruction = any hasExactProjection nominals+    coreImports =+      ["FieldProjection (..)", "FieldWitness"]+        <> (if hasReconstruction then ["ExactFieldProjection (..)", "exactFieldWitness"] else [])+        <> ["fieldWitness" | hasInexactProjection]+    nominalCodecImports =+      ["nominalToRepresentation"]+        <> ["nominalFromRepresentation" | hasReconstruction]+    hasScalar wanted nominal = (.representation) nominal == ScalarRepresentation wanted+    hasId nominal = case (.representation) nominal of IdRepresentation {} -> True; _ -> False+    hasEnforcedId nominal = case (.representation) nominal of+      IdRepresentation prefix -> isJust (idDomainContractFor languageContract prefix)+      _ -> False+    hasUnenforcedId nominal = case (.representation) nominal of+      IdRepresentation prefix -> isNothing (idDomainContractFor languageContract prefix)+      _ -> False+    hasExactDomain nominal = case (.representation) nominal of ScalarRepresentation {} -> False; _ -> True+    usesText nominal = case (.representation) nominal of ScalarRepresentation NominalText -> True; IdRepresentation {} -> True; EnumRepresentation {} -> True; _ -> False+    importPlan =+      planImportsOrDie+        moduleName+        ( Set.fromList+            [ tagName+            | nominal <- nominals,+              tagName <- case (.representation) nominal of+                ScalarRepresentation {} -> [(.name) nominal <> "NominalProjection"]+                IdRepresentation {} -> [nominalEqualityTagName nominal]+                EnumRepresentation {} -> [nominalEqualityTagName nominal]+            ]+        )+        ( Set.fromList+            [ reference+            | nominal <- nominals,+              ConsumerNominal binding <- [(.ownership) nominal],+              reference <-+                [ haskellTypeReference ((.haskell) binding),+                  qualifiedValueReference ((.binding) binding)+                ]+                  <> case (.representation) nominal of+                    EnumRepresentation constructors ->+                      HaskellReference representationModule (lowerFirst ((.name) nominal) <> "RepresentationText") ValueNamespace RequireQualified+                        : [ HaskellReference representationModule constructor ConstructorNamespace RequireQualified+                          | (constructor, _) <- NE.toList constructors+                          ]+                      where+                        representationModule = nominalRepresentationModule ctx ((.name) nominal)+                    _ -> []+            ]+        )+    emitNominalProjection nominal = case (.ownership) nominal of+      GeneratedNominal -> ""+      ConsumerNominal binding -> case (.representation) nominal of+        ScalarRepresentation {} -> emitScalarProjection nominal binding+        IdRepresentation prefix -> emitConsumerIdProjection nominal binding prefix+        EnumRepresentation constructors -> emitConsumerEnumProjection nominal binding constructors+    emitScalarProjection nominal binding =+      nl+        [ "data " <> tagName,+          "",+          "instance FieldProjection " <> tagName <> " where",+          "  type FieldName " <> tagName <> " = " <> tshow name,+          "  type FieldOwner " <> tagName <> " = " <> renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding)),+          "  type FieldResult " <> tagName <> " = " <> scalarHaskellType ((.representation) nominal),+          "  fieldShapeId _ = " <> tshow (unCanonicalTypeId ((.canonical) binding)),+          "  projectFieldValue _ = nominalToRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding)),+          "",+          witnessName <> " :: FieldWitness " <> tagName,+          witnessName <> " = fieldWitness @" <> tagName+        ]+      where+        name = (.name) nominal+        tagName = name <> "NominalProjection"+        witnessName = lowerFirst name <> "Witness"+    emitConsumerIdProjection nominal binding prefix =+      nl+        ( patternLines+            <> [ "",+                 "data " <> tagName,+                 "",+                 "instance FieldProjection " <> tagName <> " where",+                 "  type FieldName " <> tagName <> " = " <> tshow name,+                 "  type FieldOwner " <> tagName <> " = " <> ownerType,+                 "  type FieldResult " <> tagName <> " = Text",+                 "  fieldShapeId _ = " <> tshow equalityIdentity,+                 "  projectFieldValue _ = KindID.toText . nominalToRepresentation " <> bindingName,+                 "",+                 "instance ExactFieldProjection " <> tagName <> " where",+                 "  fieldProjectionDomain _ = textProjectionDomain " <> patternName,+                 "  reconstructFieldOwner _ value"+               ]+            <> validationGuard+            <> [ "    | not (matchesTextPattern " <> patternName <> " value) = Nothing",+                 "    | otherwise = case KindID.parseText @" <> tshow prefix <> " value of",+                 "        Left _ -> Nothing",+                 "        Right representation -> Just (nominalFromRepresentation " <> bindingName <> " representation)",+                 "",+                 witnessName <> " :: FieldWitness " <> tagName,+                 witnessName <> " = exactFieldWitness @" <> tagName+               ]+        )+      where+        name = (.name) nominal+        tagName = nominalEqualityTagName nominal+        witnessName = nominalEqualityWitnessName nominal+        patternName = lowerFirst name <> "EqualityPattern"+        ownerType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding))+        bindingName = renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+        equalityIdentity = fromMaybe (error "consumer ID equality contract missing") (nominalEqualityIdentityForService languageContract nominal)+        enforced = isJust (idDomainContractFor languageContract prefix)+        patternLines+          | enforced =+              [ patternName <> " :: TextPattern",+                patternName <> " = either (error . show) id (idDomainTextPattern (typeIdV7Domain " <> tshow prefix <> "))"+              ]+          | otherwise =+              [ patternName <> " :: TextPattern",+                patternName <> " = either (error . show) id $ do",+                "  prefix <- textLiteral " <> tshow (prefix <> "_"),+                "  leading <- textCharSet ('0' :| \"1234567\")",+                "  crockford <- textCharSet ('0' :| \"123456789abcdefghjkmnpqrstvwxyz\")",+                "  suffix <- textRepeatBetween 25 25 crockford",+                "  pure (textConcat (prefix :| [leading, suffix]))"+              ]+        validationGuard =+          [ "    | Left _ <- validateIdDomainText (typeIdV7Domain " <> tshow prefix <> ") value = Nothing"+          | enforced+          ]+    emitConsumerEnumProjection nominal binding constructors =+      nl $+        [ "data " <> tagName,+          "",+          "instance FieldProjection " <> tagName <> " where",+          "  type FieldName " <> tagName <> " = " <> tshow name,+          "  type FieldOwner " <> tagName <> " = " <> ownerType,+          "  type FieldResult " <> tagName <> " = Text",+          "  fieldShapeId _ = " <> tshow equalityIdentity,+          "  projectFieldValue _ = " <> encoderName <> " . nominalToRepresentation " <> bindingName,+          "",+          "instance ExactFieldProjection " <> tagName <> " where",+          "  fieldProjectionDomain _ = finiteProjectionDomain (" <> renderNonEmpty (map (tshow . snd) (NE.toList constructors)) <> ")",+          "  reconstructFieldOwner _ = \\case"+        ]+          <> [ "    " <> tshow wire <> " -> Just (nominalFromRepresentation " <> bindingName <> " " <> representationConstructor constructor <> ")"+             | (constructor, wire) <- NE.toList constructors+             ]+          <> [ "    _ -> Nothing",+               "",+               witnessName <> " :: FieldWitness " <> tagName,+               witnessName <> " = exactFieldWitness @" <> tagName+             ]+      where+        name = (.name) nominal+        tagName = nominalEqualityTagName nominal+        witnessName = nominalEqualityWitnessName nominal+        ownerType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding))+        bindingName = renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+        representationModule = nominalRepresentationModule ctx name+        encoderName = renderReferenceOrDie importPlan (HaskellReference representationModule (lowerFirst name <> "RepresentationText") ValueNamespace RequireQualified)+        representationConstructor constructor = renderReferenceOrDie importPlan (HaskellReference representationModule constructor ConstructorNamespace RequireQualified)+        equalityIdentity = fromMaybe (error "consumer enum equality contract missing") (nominalEqualityIdentityForService languageContract nominal)+    scalarHaskellType representation = case representation of+      ScalarRepresentation NominalText -> "Text"+      ScalarRepresentation NominalInt -> "Int"+      ScalarRepresentation NominalNatural -> "Natural"+      ScalarRepresentation NominalBool -> "Bool"+      ScalarRepresentation NominalTime -> "UTCTime"+      IdRepresentation {} -> "()"+      EnumRepresentation {} -> "()"++structuralProjectionModule :: Context -> Text+structuralProjectionModule ctx = structuralPrefix ctx <> "Projections"++emitShape :: Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text+emitShape ctx graph declaration shape =+  nl $+    languagePragmas+      <> [ generatedBanner,+           "module " <> moduleName <> " (" <> shapeType <> " (..)) where",+           ""+         ]+      <> map ("import " <>) imports+      <> T.lines (renderPlannedImports importPlan)+      <> ["" | not (null imports) || not (T.null (renderPlannedImports importPlan))]+      <> [shapeDeclaration]+  where+    moduleName = structuralShapeModule ctx ((.name) declaration)+    shapeType = (.name) declaration <> "Shape"+    requirements = shapeRequirements ctx graph shape+    languagePragmas = renderGeneratedLanguagePragmas []+    imports =+      sort . nub $+        ["Data.Aeson (Value)" | ReqJson `elem` requirements]+          <> ["Data.Map.Strict (Map)" | ReqMap `elem` requirements]+          <> ["Data.Text (Text)" | ReqText `elem` requirements]+          <> ["Data.Time (UTCTime)" | ReqTime `elem` requirements]+          <> ["GHC.Generics (Generic)"]+          <> ["Numeric.Natural (Natural)" | ReqNatural `elem` requirements]+    shapeDeclaration =+      foldMappedShape+        MappedShapeAlgebra+          { onRecord = \constructor _ fields ->+              nl $+                ["data " <> shapeType <> " = " <> constructor]+                  <> recordFields+                    [ ((.haskell) field, renderShapeType importPlan ctx graph ((.valueType) field))+                    | field <- fields+                    ]+                  <> ["  deriving stock (Eq, Generic, Show)"],+            onEnum = \entries ->+              "data "+                <> shapeType+                <> " = "+                <> T.intercalate " | " (map (.ctor) entries)+                <> "\n  deriving stock (Eq, Generic, Show)",+            onUnion = \_ arms ->+              nl $+                case arms of+                  [] -> ["data " <> shapeType <> " = " <> shapeType <> "Empty", "  deriving stock (Eq, Generic, Show)"]+                  firstArm : rest ->+                    ["data " <> shapeType <> " = " <> renderArm firstArm]+                      <> ["  | " <> renderArm arm | arm <- rest]+                      <> ["  deriving stock (Eq, Generic, Show)"]+          }+        shape+    renderArm arm = (.ctor) arm <> maybe "" ((" !" <>) . renderShapeType importPlan ctx graph) ((.payload) arm)+    importPlan =+      planImportsOrDie+        moduleName+        (Set.singleton shapeType)+        (Set.fromList [reference | ReqReference reference <- requirements])++data ShapeRequirement+  = ReqJson+  | ReqMap+  | ReqText+  | ReqTime+  | ReqNatural+  | ReqReference !HaskellReference+  deriving stock (Eq, Ord, Show)++shapeRequirements :: Context -> TypeGraph -> ResolvedMappedShape -> [ShapeRequirement]+shapeRequirements ctx graph =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \_ _ fields -> concatMap (exprRequirements ctx graph . (.valueType)) fields,+        onEnum = const [],+        onUnion = \_ arms -> concatMap (maybe [] (exprRequirements ctx graph) . (.payload)) arms+      }++exprRequirements :: Context -> TypeGraph -> ResolvedTypeExpr -> [ShapeRequirement]+exprRequirements ctx graph =+  foldTypeExpr+    TypeExprAlgebra+      { onText = [ReqText],+        onInt = [],+        onInteger = [],+        onBool = [],+        onNatural = [ReqNatural],+        onTime = [ReqTime],+        onJson = [ReqJson],+        onOptional = id,+        onList = id,+        onMap = (ReqMap :) . (ReqText :),+        onRef = \key -> case Map.lookup key ((.declarations) graph) of+          Just (ResolvedStructural declaration _) ->+            [ ReqReference+                ( HaskellReference+                    (structuralShapeModule ctx ((.name) declaration))+                    ((.name) declaration <> "Shape")+                    TypeNamespace+                    RequireQualified+                )+            ]+          Just (ResolvedOpaque declaration) -> [ReqReference (haskellTypeReference ((.haskell) declaration))]+          Nothing -> []+      }++renderShapeType :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedTypeExpr -> Text+renderShapeType importPlan ctx graph =+  renderStrictOrApplicationArgument+    . foldTypeExpr+      TypeExprAlgebra+        { onText = atomicShapeType "Text",+          onInt = atomicShapeType "Int",+          onInteger = atomicShapeType "Integer",+          onBool = atomicShapeType "Bool",+          onNatural = atomicShapeType "Natural",+          onTime = atomicShapeType "UTCTime",+          onJson = atomicShapeType "Value",+          onOptional = applicationShapeType . ("Maybe " <>) . renderStrictOrApplicationArgument,+          onList = atomicShapeType . ("[" <>) . (<> "]") . (.text),+          onMap = applicationShapeType . ("Map Text " <>) . renderStrictOrApplicationArgument,+          onRef =+            atomicShapeType . \key -> case Map.lookup key ((.declarations) graph) of+              Just (ResolvedStructural nested _) ->+                renderReferenceOrDie+                  importPlan+                  (HaskellReference (structuralShapeModule ctx ((.name) nested)) ((.name) nested <> "Shape") TypeNamespace RequireQualified)+              Just (ResolvedOpaque opaque) ->+                renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) opaque))+              Nothing -> "()"+        }++data ShapeTypePrecedence+  = AtomicShapeType+  | ApplicationShapeType++data RenderedShapeType = RenderedShapeType+  { precedence :: !ShapeTypePrecedence,+    text :: !Text+  }++atomicShapeType :: Text -> RenderedShapeType+atomicShapeType = RenderedShapeType AtomicShapeType++applicationShapeType :: Text -> RenderedShapeType+applicationShapeType = RenderedShapeType ApplicationShapeType++renderStrictOrApplicationArgument :: RenderedShapeType -> Text+renderStrictOrApplicationArgument rendered = case (.precedence) rendered of+  AtomicShapeType -> (.text) rendered+  ApplicationShapeType -> "(" <> (.text) rendered <> ")"++data StructuralProjection = StructuralProjection+  { tag :: !Text,+    witness :: !Text,+    pointer :: !Text,+    owner :: !HaskellSource,+    result :: !Text,+    canonical :: !CanonicalTypeId,+    binding :: !QualifiedValueName,+    selectors :: ![(Text, Text)]+  }+  deriving stock (Eq, Show)++projectionSpecs :: TypeGraph -> [StructuralProjection]+projectionSpecs graph =+  sortOn (.tag) . allocateProjectionNames . concat $+    [ projectionsForRoot graph declaration shape+    | ResolvedStructural declaration shape <- Map.elems ((.declarations) graph)+    ]++projectionsForRoot :: TypeGraph -> StructuralDecl -> ResolvedMappedShape -> [StructuralProjection]+projectionsForRoot graph root rootShape = case rootShape of+  RRecord _ _ fields -> concatMap (walkField [] []) fields+  REnum {} -> []+  RUnion {} -> []+  where+    walkField keys selectors field+      | (.presence) field /= PRequired = []+      | otherwise = case projectionScalar ((.valueType) field) of+          Just result -> [mkProjection (keys <> [(.key) field]) (selectors <> [(shapeModuleForOwner, (.haskell) field)]) result]+          Nothing -> case (.valueType) field of+            RRef key -> case Map.lookup key ((.declarations) graph) of+              Just (ResolvedStructural nested (RRecord _ _ nestedFields)) ->+                concatMap+                  (walkNested nested (keys <> [(.key) field]) (selectors <> [(shapeModuleForOwner, (.haskell) field)]))+                  nestedFields+              _ -> []+            _ -> []+      where+        shapeModuleForOwner = "__SHAPE__." <> (.name) root++    walkNested owner keys selectors field+      | (.presence) field /= PRequired = []+      | otherwise = case projectionScalar ((.valueType) field) of+          Just result -> [mkProjection (keys <> [(.key) field]) (selectors <> [(shapeModuleFor owner, (.haskell) field)]) result]+          Nothing -> case (.valueType) field of+            RRef key -> case Map.lookup key ((.declarations) graph) of+              Just (ResolvedStructural nested (RRecord _ _ nestedFields)) ->+                concatMap+                  (walkNested nested (keys <> [(.key) field]) (selectors <> [(shapeModuleFor owner, (.haskell) field)]))+                  nestedFields+              _ -> []+            _ -> []++    -- Context is supplied when rendering; this marker is replaced there.+    shapeModuleFor declaration = "__SHAPE__." <> (.name) declaration+    mkProjection keys selectors result =+      StructuralProjection+        { tag = nameStem <> "Projection",+          witness = lowerFirst nameStem <> "Witness",+          pointer = pointer,+          owner = (.haskell) root,+          result = result,+          canonical = (.canonical) root,+          binding = (.binding) root,+          selectors = selectors+        }+      where+        pointer = T.concat ["/" <> escapePointer key | key <- keys]+        nameStem = projectionNameStem ((.name) root) pointer++projectionScalar :: ResolvedTypeExpr -> Maybe Text+projectionScalar = \case+  RText -> Just "Text"+  RInt -> Just "Int"+  RInteger -> Just "Integer"+  RBool -> Just "Bool"+  RTime -> Just "UTCTime"+  RNatural -> Just "Natural"+  RJson -> Nothing+  ROptional {} -> Nothing+  RList {} -> Nothing+  RMap {} -> Nothing+  RRef {} -> Nothing++escapePointer :: Text -> Text+escapePointer = T.replace "/" "~1" . T.replace "~" "~0"++projectionNameStem :: Name -> Text -> Text+projectionNameStem owner pointer =+  pascal owner+    <> T.concat+      [ normaliseAliasPart (unescapePointer segment)+      | segment <- filter (not . T.null) (T.splitOn "/" pointer)+      ]++-- | Add a stable digest only when two distinct wire paths normalize to the+-- same Haskell name. Digest collisions receive a deterministic ordinal, so the+-- emitter never produces duplicate declarations even in that unlikely case.+allocateProjectionNames :: [StructuralProjection] -> [StructuralProjection]+allocateProjectionNames specs = concatMap allocateGroup groups+  where+    groups = groupBy (\left right -> (.tag) left == (.tag) right) (sortOn (.tag) specs)+    allocateGroup [spec] = [spec]+    allocateGroup collided = reverse named+      where+        ordered = sortOn projectionIdentity collided+        digest spec = T.take 8 (fnv1a64 (projectionIdentity spec))+        digestCounts = Map.fromListWith (+) [(digest spec, 1 :: Int) | spec <- ordered]+        (_, named) = foldl allocate (Map.empty, []) ordered+        allocate (seen, allocated) spec =+          let shortDigest = digest spec+              occurrence = Map.findWithDefault 0 shortDigest seen + 1+              suffix =+                shortDigest+                  <> if Map.findWithDefault 0 shortDigest digestCounts == 1+                    then ""+                    else tshow' occurrence+           in (Map.insert shortDigest occurrence seen, renameWithSuffix suffix spec : allocated)+    projectionIdentity spec = unCanonicalTypeId ((.canonical) spec) <> "#" <> (.pointer) spec+    renameWithSuffix suffix spec =+      StructuralProjection+        { tag = nameStem <> suffix <> "Projection",+          witness = lowerFirst nameStem <> suffix <> "Witness",+          pointer = spec.pointer,+          owner = spec.owner,+          result = spec.result,+          canonical = spec.canonical,+          binding = spec.binding,+          selectors = spec.selectors+        }+      where+        nameStem = fromMaybe ((.tag) spec) (T.stripSuffix "Projection" ((.tag) spec))++projectionWitnessName :: TypeGraph -> MappedKey -> Text -> Maybe Text+projectionWitnessName graph owner pointer = do+  ResolvedStructural declaration _ <- Map.lookup owner ((.declarations) graph)+  (.witness)+    <$> find+      (\spec -> (.canonical) spec == (.canonical) declaration && (.pointer) spec == pointer)+      (projectionSpecs graph)++emitStructuralProjections :: Context -> TypeGraph -> Text+emitStructuralProjections ctx graph =+  nl $+    renderGeneratedLanguagePragmas [ExtTypeFamilies | not (null specs)]+      <> [ generatedBanner,+           "-- Equality witnesses are emitted for Text, Int, Bool, Natural, and UTCTime.",+           "-- Int, Natural, and UTCTime belong to Keiki's ordered subset.",+           "module " <> moduleName,+           "  ( " <> T.intercalate "\n  , " (map (.witness) specs),+           "  ) where",+           ""+         ]+      <> staticImports+      <> fieldScopeImports+      <> T.lines (renderPlannedImports importPlan)+      <> concatMap renderProjection specs+  where+    moduleName = structuralProjectionModule ctx+    specs = map (resolveProjectionModules ctx) (projectionSpecs graph)+    resultTypes = Set.fromList (map (.result) specs)+    staticImports =+      ["import Data.Text (Text)" | "Text" `Set.member` resultTypes]+        <> ["import Data.Time (UTCTime)" | "UTCTime" `Set.member` resultTypes]+        <> ["import Numeric.Natural (Natural)" | "Natural" `Set.member` resultTypes]+        <> ["import Keiro.Codec.Structural (bindingToShape)" | not (null specs)]+        <> ["import Keiki.Core (FieldProjection (..), FieldWitness, fieldWitness)" | not (null specs)]+    fieldScopeImports =+      [ "import " <> shapeModuleName <> " (" <> lastSegment shapeModuleName <> "Shape(" <> T.intercalate ", " (Set.toAscList selectors) <> "))"+      | (shapeModuleName, selectors) <- Map.toAscList selectorsByModule+      ]+    selectorsByModule =+      Map.fromListWith+        Set.union+        [ (shapeModuleName, Set.singleton selector)+        | spec <- specs,+          (shapeModuleName, selector) <- (.selectors) spec+        ]+    importPlan =+      planImportsOrDie+        moduleName+        (Set.fromList (map (.tag) specs))+        ( Set.fromList+            ( [haskellTypeReference ((.owner) spec) | spec <- specs]+                <> [qualifiedValueReference ((.binding) spec) | spec <- specs]+            )+        )+    renderProjection spec =+      [ "",+        "data " <> (.tag) spec,+        "",+        "instance FieldProjection " <> (.tag) spec <> " where",+        "  type FieldName " <> (.tag) spec <> " = " <> tshow ((.pointer) spec),+        "  type FieldOwner " <> (.tag) spec <> " = " <> renderReferenceOrDie importPlan (haskellTypeReference ((.owner) spec)),+        "  type FieldResult " <> (.tag) spec <> " = " <> (.result) spec,+        "  fieldShapeId _ = " <> tshow (unCanonicalTypeId ((.canonical) spec)),+        "  projectFieldValue _ owner = " <> renderGetter spec,+        "",+        (.witness) spec <> " :: FieldWitness " <> (.tag) spec,+        (.witness) spec <> " = fieldWitness @" <> (.tag) spec+      ]+    renderGetter spec =+      foldl+        ( \value (_shapeModuleName, selector) ->+            "(" <> value <> ")." <> selector+        )+        ("bindingToShape " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) spec)) <> " owner")+        ((.selectors) spec)++resolveProjectionModules :: Context -> StructuralProjection -> StructuralProjection+resolveProjectionModules ctx spec =+  StructuralProjection+    { tag = spec.tag,+      witness = spec.witness,+      pointer = spec.pointer,+      owner = spec.owner,+      result = spec.result,+      canonical = spec.canonical,+      binding = spec.binding,+      selectors =+        [ (replaceModule marker, selector)+        | (marker, selector) <- spec.selectors+        ]+    }+  where+    replaceModule marker+      | Just name <- T.stripPrefix "__SHAPE__." marker = structuralShapeModule ctx name+      | otherwise = structuralShapeModule ctx (lastSegment marker)++haskellTypeReference :: HaskellSource -> HaskellReference+haskellTypeReference source =+  HaskellReference ((.moduleName) source) ((.valueType) source) TypeNamespace PreferUnqualified++qualifiedValueReference :: QualifiedValueName -> HaskellReference+qualifiedValueReference qualified =+  HaskellReference moduleName valueName ValueNamespace RequireQualified+  where+    (moduleName, valueName) = splitQualified (unQualifiedValueName qualified)++renderReferenceOrDie :: HaskellImportPlan -> HaskellReference -> Text+renderReferenceOrDie importPlan =+  either+    (error . ("validated Haskell reference failed: " <>) . show)+    id+    . renderPlannedReference importPlan++planImportsOrDie :: Text -> Set.Set Text -> Set.Set HaskellReference -> HaskellImportPlan+planImportsOrDie target localDeclarations =+  either+    (error . ("validated Haskell import planning failed: " <>) . show)+    id+    . planHaskellImports+      ImportEnvironment+        { targetModule = target,+          localNames = localDeclarations,+          reservedQualifiers = rendererReservedQualifiers+        }++rendererReservedQualifiers :: Set.Set Text+rendererReservedQualifiers =+  Set.fromList+    [ "Aeson",+      "AesonKey",+      "AesonKeyMap",+      "B",+      "GeneratedNominals",+      "Holes",+      "K",+      "Key",+      "KeyMap",+      "KindID",+      "Map",+      "NominalProjections",+      "NonEmpty",+      "S",+      "Set",+      "StructuralProjections",+      "T"+    ]++splitQualified :: Text -> (Text, Text)+splitQualified value =+  let (prefix, name) = T.breakOnEnd "." value+   in (T.dropEnd 1 prefix, name)++lastSegment :: Text -> Text+lastSegment = snd . T.breakOnEnd "."++-- | Emit all modules for one aggregate. The 'Spec' is needed for the shared+-- id\/enum declarations.+scaffoldAggregate :: Context -> Spec -> Aggregate -> [ScaffoldModule]+scaffoldAggregate ctx spec = scaffoldAggregateForService ctx (legacyCheckedService spec)++-- | Emit all modules for one aggregate after selecting the effective semantic+-- contract. This is the normal source/workspace generation entry point.+scaffoldAggregateForService :: Context -> CheckedService -> Aggregate -> [ScaffoldModule]+scaffoldAggregateForService ctx service agg =+  [ genModule a "Domain" (emitDomain a),+    genModule a "Codec" (emitCodec a)+  ]+    ++ ( if hasVersion2Ownership a+           then+             [ genModule a "Transducer" (emitGeneratedTransducer a),+               genModule a "BehaviorContract" (emitBehaviorContract a),+               behaviorHoleModule a+             ]+           else []+       )+    ++ [ genModule a "EventStream" (emitEventStream a),+         genModule a "Projection" (emitProjection a)+       ]+    ++ [holeModule a (emitHoles a) | aggregateNeedsHoleModule a]+  where+    a = resolveAggForService ctx service agg++aggregateNeedsHoleModule :: Agg -> Bool+aggregateNeedsHoleModule aggregate+  | hasVersion2Ownership aggregate = not (null (version2HoleExports aggregate))+  | otherwise = True++-- | The generated behavioral contract is deliberately separate from both the+-- authoritative transducer and the create-once witness list.  Regeneration can+-- replace this module freely while stale textual keys in @BehaviorHoles@ keep+-- compiling and are reported by reconciliation.+emitBehaviorContract :: Agg -> Text+emitBehaviorContract aggregate =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedLabels | not (null ((.regs) aggregate))]+      <> [ generatedBanner,+           "module " <> (.genPrefix) aggregate <> ".BehaviorContract",+           "  ( BehaviorKey (..)",+           "  , unBehaviorKey",+           "  , ObligationKind (..)",+           "  , EvidenceLevel (..)",+           "  , GuardCoverage (..)",+           "  , BehaviorRequirement (..)",+           "  , RejectionClass (..)",+           "  , LiveExpectation (..)",+           "  , BehaviorWitness (..)",+           "  , BehaviorFailure (..)",+           "  , BehaviorConformanceReport (..)",+           "  , behaviorRequirements",+           "  , behaviorCoverageReport",+           "  , behaviorConformancePassed",+           "  , behaviorConformancePassedWith",+           "  , renderBehaviorConformanceText",+           "  ) where",+           "",+           "import " <> (.genPrefix) aggregate <> ".Codec (encode" <> name <> "Event, parse" <> name <> "Event, " <> valueStem <> "Codec)",+           "import " <> (.genPrefix) aggregate <> ".Domain",+           "import " <> (.genPrefix) aggregate <> ".Transducer (" <> valueStem <> "Transducer)",+           "import " <> contextGeneratedPrefix ((.context) aggregate) <> ".BehaviorSourceMap qualified as BehaviorSourceMap"+         ]+      <> outcomeBehaviorImports+      <> [ "import Data.Aeson (ToJSON (..), object, (.=))",+           "import Data.List (sortOn)",+           "import Data.List.NonEmpty (NonEmpty)",+           "import Data.List.NonEmpty qualified as NonEmpty",+           "import Data.Map.Strict qualified as Map",+           "import Data.Text (Text)",+           "import Data.Text qualified as T",+           "import Keiki.Core qualified as K (" <> T.intercalate ", " behaviorCoreImports <> ")",+           "import Keiro.Codec qualified as Codec (Codec (eventType), EventType (..))",+           "",+           "newtype BehaviorKey = BehaviorKey { unBehaviorKey :: Text }",+           "  deriving stock (Eq, Ord, Show)",+           "",+           "unBehaviorKey :: BehaviorKey -> Text",+           "unBehaviorKey (BehaviorKey value) = value",+           "",+           "data ObligationKind = LiveTransition | RequiredRejection | ReplayTransition",+           "  deriving stock (Eq, Ord, Show)",+           "",+           "data EvidenceLevel = GeneratedAuthoritative | HoleWitnessed | LegacyRuntimeWitness",+           "  deriving stock (Eq, Ord, Show)",+           "",+           "data GuardCoverage = GuardTotal | GuardPartial | GuardUnknown | GuardNotApplicable",+           "  deriving stock (Eq, Ord, Show)",+           "",+           "data BehaviorRequirement = BehaviorRequirement",+           "  { requirementKey :: !BehaviorKey",+           "  , requirementKind :: !ObligationKind",+           "  , requirementEvidence :: !EvidenceLevel",+           "  , requirementGuardCoverage :: !GuardCoverage",+           "  , requirementSource :: !" <> (.vertexType) aggregate,+           "  , requirementCommandName :: !Text",+           "  , requirementExpectedEdge :: !(Maybe (K.EdgeRef " <> (.vertexType) aggregate <> "))",+           "  , requirementTarget :: !(Maybe " <> (.vertexType) aggregate <> ")",+           "  , requirementEventKinds :: ![Text]",+           "  }",+           "  deriving stock (Eq, Show)",+           "",+           "data RejectionClass = RejectNoOutgoingEdges | RejectNoMatchingEdge",+           "  deriving stock (Eq, Show)",+           "",+           "data LiveExpectation",+           "  = Emits (NonEmpty " <> name <> "Event)",+           "  | Rejects RejectionClass"+         ]+      <> outcomeExpectationConstructors+      <> [ "  | NoOp",+           "  deriving stock (Eq, Show)",+           "",+           "data BehaviorWitness",+           "  = Pending BehaviorKey",+           "  | LiveWitness",+           "      { witnessKey :: BehaviorKey",+           "      , witnessHistory :: [" <> name <> "Event]",+           "      , witnessCommand :: " <> name <> "Command",+           "      , witnessExpected :: LiveExpectation",+           "      }",+           "  | ReplayWitness",+           "      { witnessKey :: BehaviorKey",+           "      , witnessHistoryPrefix :: [" <> name <> "Event]",+           "      , witnessObservedChunk :: [" <> name <> "Event]",+           "      }",+           "  deriving stock (Eq, Show)",+           "",+           "data BehaviorFailure = BehaviorFailure",+           "  { failureKey :: !BehaviorKey",+           "  , failureSubject :: !Text",+           "  , failureCode :: !Text",+           "  , failureDetail :: !Text",+           "  }",+           "  deriving stock (Eq, Show)",+           "",+           "instance ToJSON BehaviorFailure where",+           "  toJSON behaviorFailure = object",+           "    [ \"key\" .= unBehaviorKey behaviorFailure.failureKey",+           "    , \"subject\" .= behaviorFailure.failureSubject",+           "    , \"code\" .= behaviorFailure.failureCode",+           "    , \"detail\" .= behaviorFailure.failureDetail",+           "    ]",+           "",+           "data BehaviorConformanceReport = BehaviorConformanceReport",+           "  { reportRequired :: ![BehaviorKey]",+           "  , reportFilled :: ![BehaviorKey]",+           "  , reportPending :: ![BehaviorKey]",+           "  , reportMissing :: ![BehaviorKey]",+           "  , reportDuplicate :: ![BehaviorKey]",+           "  , reportStale :: ![BehaviorKey]",+           "  , reportFailed :: ![BehaviorFailure]",+           "  , reportVerified :: ![BehaviorKey]",+           "  , reportUnverified :: ![BehaviorKey]",+           "  }",+           "  deriving stock (Eq, Show)",+           "",+           "instance ToJSON BehaviorConformanceReport where",+           "  toJSON report = object",+           "    [ \"schema\" .= (\"keiro/behavior-conformance/1\" :: Text)",+           "    , \"required\" .= keyTexts report.reportRequired",+           "    , \"filled\" .= keyTexts report.reportFilled",+           "    , \"pending\" .= keyTexts report.reportPending",+           "    , \"missing\" .= keyTexts report.reportMissing",+           "    , \"duplicate\" .= keyTexts report.reportDuplicate",+           "    , \"stale\" .= keyTexts report.reportStale",+           "    , \"failed\" .= report.reportFailed",+           "    , \"verified\" .= keyTexts report.reportVerified",+           "    , \"unverified\" .= keyTexts report.reportUnverified",+           "    ]",+           "",+           "behaviorRequirements :: [BehaviorRequirement]",+           "behaviorRequirements ="+         ]+      <> renderBehaviorRequirementList aggregate+      <> [ "",+           "behaviorCoverageReport :: [BehaviorWitness] -> BehaviorConformanceReport",+           "behaviorCoverageReport witnesses =",+           "  BehaviorConformanceReport",+           "    { reportRequired = sortedKeys (Map.keys requiredByKey)",+           "    , reportFilled = sortedKeys [key | (key, [witness]) <- Map.toList witnessGroups, Map.member key requiredByKey, not (isPending witness)]",+           "    , reportPending = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, Map.member key requiredByKey, any isPending rows]",+           "    , reportMissing = sortedKeys [key | key <- Map.keys requiredByKey, Map.notMember key witnessGroups]",+           "    , reportDuplicate = sortedKeys [key | (key, rows) <- Map.toList witnessGroups, length rows > 1]",+           "    , reportStale = sortedKeys [key | key <- Map.keys witnessGroups, Map.notMember key requiredByKey]",+           "    , reportFailed = sortOn (unBehaviorKey . (.failureKey)) failures",+           "    , reportVerified = sortedKeys [requirement.requirementKey | (requirement, Right ()) <- executions, proofStrength requirement]",+           "    , reportUnverified = sortedKeys [requirement.requirementKey | (requirement, Right ()) <- executions, not (proofStrength requirement)]",+           "    }",+           " where",+           "  requiredByKey = Map.fromList [(requirement.requirementKey, requirement) | requirement <- behaviorRequirements]",+           "  witnessGroups = Map.fromListWith (flip (<>)) [(behaviorWitnessKey witness, [witness]) | witness <- witnesses]",+           "  executions =",+           "    [ (requirement, runWitness requirement witness)",+           "    | (key, [witness]) <- Map.toList witnessGroups",+           "    , not (isPending witness)",+           "    , Just requirement <- [Map.lookup key requiredByKey]",+           "    ]",+           "  failures = [behaviorFailure | (_, Left behaviorFailure) <- executions]",+           "",+           "behaviorConformancePassed :: BehaviorConformanceReport -> Bool",+           "behaviorConformancePassed = behaviorConformancePassedWith False",+           "",+           "behaviorConformancePassedWith :: Bool -> BehaviorConformanceReport -> Bool",+           "behaviorConformancePassedWith failOnUnverified report =",+           "  null report.reportPending",+           "    && null report.reportMissing",+           "    && null report.reportDuplicate",+           "    && null report.reportStale",+           "    && null report.reportFailed",+           "    && (not failOnUnverified || null report.reportUnverified)",+           "",+           "renderBehaviorConformanceText :: BehaviorConformanceReport -> Text",+           "renderBehaviorConformanceText report = T.unlines",+           "  [ \"behavior conformance: " <> name <> "\"",+           "  , \"schema: keiro/behavior-conformance/1\"",+           "  , countLine \"required\" report.reportRequired",+           "  , countLine \"filled\" report.reportFilled",+           "  , countLine \"pending\" report.reportPending",+           "  , countLine \"missing\" report.reportMissing",+           "  , countLine \"duplicate\" report.reportDuplicate",+           "  , countLine \"stale\" report.reportStale",+           "  , \"failed: \" <> tshow (length report.reportFailed)",+           "  , countLine \"verified\" report.reportVerified",+           "  , countLine \"unverified\" report.reportUnverified",+           "  ] <> T.unlines [\"FAIL \" <> unBehaviorKey behaviorFailure.failureKey <> \" \" <> behaviorFailure.failureSubject <> \" [\" <> behaviorFailure.failureCode <> \"] \" <> behaviorFailure.failureDetail | behaviorFailure <- report.reportFailed]",+           "",+           "runWitness :: BehaviorRequirement -> BehaviorWitness -> Either BehaviorFailure ()",+           "runWitness requirement witness = case witness of",+           "  Pending _ -> failure requirement \"pending\" \"witness is still Pending\"",+           "  LiveWitness _ history command expectation -> runLive requirement history command expectation",+           "  ReplayWitness _ prefix chunk -> runReplay requirement prefix chunk",+           "",+           "runLive :: BehaviorRequirement -> [" <> name <> "Event] -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",+           "runLive requirement history command expectation = do",+           "  settled <- settleHistory requirement \"history\" history",+           "  ensure requirement (K.replaySuccessState settled == requirement.requirementSource) \"history-wrong-source\" \"history does not settle at the required source vertex\"",+           "  ensure requirement (commandKind command == requirement.requirementCommandName) \"command-mismatch\" \"witness command constructor does not match the required state/command cell\"",+           "  case requirement.requirementKind of",+           "    ReplayTransition -> failure requirement \"witness-kind\" \"a replay-only requirement needs ReplayWitness\"",+           "    RequiredRejection -> runRejection requirement (K.replaySuccessState settled, K.replaySuccessRegs settled) command expectation",+           "    LiveTransition -> runAcceptance requirement (K.replaySuccessState settled, K.replaySuccessRegs settled) command expectation",+           "",+           "runRejection :: BehaviorRequirement -> (" <> (.vertexType) aggregate <> ", K.RegFile " <> name <> "Regs) -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",+           "runRejection requirement seed command expectation = case expectation of",+           "  Emits _ -> failure requirement \"expectation-kind\" \"a rejection requirement cannot expect emitted events\""+         ]+      <> outcomeGenericRejectionCases+      <> [ "  NoOp -> failure requirement \"expectation-kind\" \"a rejection requirement cannot expect an accepted no-op\"",+           "  Rejects expectedClass -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",+           "    Left K.NoOutgoingEdges {} -> ensure requirement (expectedClass == RejectNoOutgoingEdges) \"rejection-class\" \"expected NoMatchingEdge but runtime returned NoOutgoingEdges\"",+           "    Left K.NoMatchingEdge {} -> ensure requirement (expectedClass == RejectNoMatchingEdge) \"rejection-class\" \"expected NoOutgoingEdges but runtime returned NoMatchingEdge\"",+           "    Left K.AmbiguousEdges {} -> failure requirement \"ambiguous-edges\" \"AmbiguousEdges can never satisfy a rejection witness\"",+           "    Right _ -> failure requirement \"unexpected-acceptance\" \"runtime accepted a command required to reject\"",+           "",+           "runAcceptance :: BehaviorRequirement -> (" <> (.vertexType) aggregate <> ", K.RegFile " <> name <> "Regs) -> " <> name <> "Command -> LiveExpectation -> Either BehaviorFailure ()",+           "runAcceptance requirement seed command expectation = case expectation of",+           "  Rejects _ -> failure requirement \"expectation-kind\" \"a live-transition requirement needs Emits or NoOp\""+         ]+      <> outcomeExactAcceptanceCases+      <> genericNoOpAcceptanceLines+      <> [ "  Emits expectedEvents -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",+           "    Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",+           "    Right success -> do",+           "      checkAcceptedEnvelope requirement success",+           "      let expected = NonEmpty.toList expectedEvents",+           "          actual = K.stepSuccessOutputs success",+           "      ensure requirement (actual == expected) \"event-value-mismatch\" (\"runtime event values differ from the exact witness expectation; actual=\" <> tshow actual <> \" expected=\" <> tshow expected)",+           "      ensure requirement (map eventKind actual == requirement.requirementEventKinds) \"event-envelope-mismatch\" (\"runtime event kinds differ from the declared ordered envelope; actual=\" <> tshow (map eventKind actual) <> \" expected=\" <> tshow requirement.requirementEventKinds)",+           "      decoded <- either (failure requirement \"emitted-codec-decode\") Right (decodeEvents actual)",+           "      replayed <- case K.applyEventsDetailedEither " <> valueStem <> "Transducer seed decoded of",+           "        Left replayFailure -> failure requirement \"emitted-replay-failed\" (tshow replayFailure)",+           "        Right replaySuccess -> Right replaySuccess",+           "      ensure requirement (K.replaySuccessState replayed == K.stepSuccessState success) \"forward-replay-vertex\" \"decoded emissions replay to a different vertex\"",+           "      ensure requirement (regsEqual (K.replaySuccessRegs replayed) (K.stepSuccessRegs success)) \"forward-replay-registers\" \"decoded emissions replay to different registers\"",+           "      checkSingleAttribution requirement K.Live (length decoded) (K.replaySuccessTrace replayed)"+         ]+      <> outcomeSilentRunnerLines+      <> [ "",+           "checkAcceptedEnvelope :: BehaviorRequirement -> K.StepSuccess " <> name <> "Regs " <> (.vertexType) aggregate <> " " <> name <> "Event -> Either BehaviorFailure ()",+           "checkAcceptedEnvelope requirement success = do",+           "  ensure requirement (K.stepSuccessMode success == K.Live) \"forward-mode\" (\"forward execution selected a non-live edge; actual=\" <> tshow (K.stepSuccessMode success) <> \" expected=\" <> tshow K.Live)",+           "  ensure requirement (Just (K.stepSuccessEdge success) == requirement.requirementExpectedEdge) \"edge-attribution\" (\"runtime selected a different guarded sibling; actual=\" <> tshow (Just (K.stepSuccessEdge success)) <> \" expected=\" <> tshow requirement.requirementExpectedEdge)",+           "  ensure requirement (Just (K.stepSuccessState success) == requirement.requirementTarget) \"target-mismatch\" (\"runtime reached a different target vertex; actual=\" <> tshow (Just (K.stepSuccessState success)) <> \" expected=\" <> tshow requirement.requirementTarget)",+           "",+           "runReplay :: BehaviorRequirement -> [" <> name <> "Event] -> [" <> name <> "Event] -> Either BehaviorFailure ()",+           "runReplay requirement prefix chunk = case requirement.requirementKind of",+           "  ReplayTransition -> do",+           "    settled <- settleHistory requirement \"history-prefix\" prefix",+           "    ensure requirement (K.replaySuccessState settled == requirement.requirementSource) \"history-wrong-source\" \"history prefix does not settle at the replay edge source\"",+           "    ensure requirement (not (null chunk)) \"empty-replay-chunk\" \"a replay-only edge has no observable empty chunk\"",+           "    decoded <- either (failure requirement \"replay-chunk-codec-decode\") Right (decodeEvents chunk)",+           "    replayed <- case K.applyEventsDetailedEither " <> valueStem <> "Transducer (K.replaySuccessState settled, K.replaySuccessRegs settled) decoded of",+           "      Left replayFailure -> failure requirement \"replay-chunk-failed\" (tshow replayFailure)",+           "      Right replaySuccess -> Right replaySuccess",+           "    ensure requirement (Just (K.replaySuccessState replayed) == requirement.requirementTarget) \"target-mismatch\" (\"replay chunk reached a different target vertex; actual=\" <> tshow (Just (K.replaySuccessState replayed)) <> \" expected=\" <> tshow requirement.requirementTarget)",+           "    checkSingleAttribution requirement K.ReplayOnly (length decoded) (K.replaySuccessTrace replayed)",+           "  _ -> failure requirement \"witness-kind\" \"ReplayWitness supplied for a non-replay requirement\"",+           "",+           "checkSingleAttribution :: BehaviorRequirement -> K.EdgeMode -> Int -> [K.ReplayAttribution " <> (.vertexType) aggregate <> "] -> Either BehaviorFailure ()",+           "checkSingleAttribution requirement expectedMode eventCount trace = case trace of",+           "  [attribution] -> do",+           "    ensure requirement (Just (K.replayAttributionEdge attribution) == requirement.requirementExpectedEdge) \"replay-edge-attribution\" (\"replay selected a different edge; actual=\" <> tshow (Just (K.replayAttributionEdge attribution)) <> \" expected=\" <> tshow requirement.requirementExpectedEdge)",+           "    ensure requirement (K.replayAttributionMode attribution == expectedMode) \"replay-mode-attribution\" (\"replay selected the wrong live/replay-only phase; actual=\" <> tshow (K.replayAttributionMode attribution) <> \" expected=\" <> tshow expectedMode)",+           "    ensure requirement (K.replayAttributionSource attribution == requirement.requirementSource) \"replay-source-attribution\" (\"replay attribution starts at the wrong source; actual=\" <> tshow (K.replayAttributionSource attribution) <> \" expected=\" <> tshow requirement.requirementSource)",+           "    ensure requirement (Just (K.replayAttributionTarget attribution) == requirement.requirementTarget) \"replay-target-attribution\" (\"replay attribution ends at the wrong target; actual=\" <> tshow (Just (K.replayAttributionTarget attribution)) <> \" expected=\" <> tshow requirement.requirementTarget)",+           "    ensure requirement (K.replayAttributionSpan attribution == K.ReplayEventSpan 0 eventCount) \"replay-span-attribution\" (\"replay attribution did not consume the exact chunk; actual=\" <> tshow (K.replayAttributionSpan attribution) <> \" expected=\" <> tshow (K.ReplayEventSpan 0 eventCount))",+           "  _ -> failure requirement \"replay-trace-cardinality\" \"expected exactly one completed-edge attribution\"",+           "",+           "settleHistory :: BehaviorRequirement -> Text -> [" <> name <> "Event] -> Either BehaviorFailure (K.ReplaySuccess " <> name <> "Regs " <> (.vertexType) aggregate <> ")",+           "settleHistory requirement label history = do",+           "  decoded <- either (failure requirement (label <> \"-codec-decode\")) Right (decodeEvents history)",+           "  case K.applyEventsDetailedEither " <> valueStem <> "Transducer (" <> initialVertex aggregate <> ", initial" <> name <> "Regs) decoded of",+           "    Left replayFailure -> failure requirement (label <> \"-replay-failed\") (tshow replayFailure)",+           "    Right replaySuccess -> Right replaySuccess",+           "",+           "decodeEvents :: [" <> name <> "Event] -> Either Text [" <> name <> "Event]",+           "decodeEvents = traverse (\\event -> parse" <> name <> "Event (Codec.eventType " <> valueStem <> "Codec event) (encode" <> name <> "Event event))"+         ]+      <> renderCommandKind aggregate+      <> [ "",+           "eventKind :: " <> name <> "Event -> Text",+           "eventKind event = case Codec.eventType " <> valueStem <> "Codec event of Codec.EventType tag -> tag",+           "",+           "regsEqual :: K.RegFile " <> name <> "Regs -> K.RegFile " <> name <> "Regs -> Bool",+           regsEqualityExpression aggregate,+           "",+           "proofStrength :: BehaviorRequirement -> Bool",+           "proofStrength requirement =",+           "  requirement.requirementEvidence == GeneratedAuthoritative",+           "    && requirement.requirementGuardCoverage `elem` [GuardTotal, GuardNotApplicable]",+           "",+           "behaviorWitnessKey :: BehaviorWitness -> BehaviorKey",+           "behaviorWitnessKey witness = case witness of",+           "  Pending key -> key",+           "  LiveWitness { witnessKey = key } -> key",+           "  ReplayWitness { witnessKey = key } -> key",+           "",+           "isPending :: BehaviorWitness -> Bool",+           "isPending Pending {} = True",+           "isPending _ = False",+           "",+           "ensure :: BehaviorRequirement -> Bool -> Text -> Text -> Either BehaviorFailure ()",+           "ensure requirement condition code detail = if condition then Right () else failure requirement code detail",+           "failure :: BehaviorRequirement -> Text -> Text -> Either BehaviorFailure failed",+           "failure requirement code detail =",+           "  Left",+           "    ( BehaviorFailure",+           "        requirement.requirementKey",+           "        (tshow requirement.requirementSource <> \" x \" <> requirement.requirementCommandName <> \": \" <> kindPhrase <> \" (\" <> BehaviorSourceMap.renderBehaviorSourceLocation (unBehaviorKey requirement.requirementKey) <> \")\")",+           "        code",+           "        detail",+           "    )",+           " where",+           "  kindPhrase = case requirement.requirementKind of",+           "    LiveTransition -> \"live transition\"",+           "    RequiredRejection -> \"required rejection\"",+           "    ReplayTransition -> \"replay-only transition\"",+           "sortedKeys :: [BehaviorKey] -> [BehaviorKey]",+           "sortedKeys = sortOn unBehaviorKey",+           "keyTexts :: [BehaviorKey] -> [Text]",+           "keyTexts = map unBehaviorKey",+           "countLine :: Text -> [BehaviorKey] -> Text",+           "countLine label values = label <> \": \" <> tshow (length values)",+           "tshow :: Show value => value -> Text",+           "tshow = T.pack . show"+         ]+  where+    name = (.name) aggregate+    valueStem = lowerFirst name+    handlerName = valueStem <> "DomainCommandHandler"+    outcomeResultTypes = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just outcomeTypes -> [(.rejectionType) outcomeTypes, (.noOpType) outcomeTypes]+    outcomeImportPlan = eventStreamImportPlan aggregate outcomeResultTypes []+    outcomeGeneratedNominals = generatedNominalsInTypes outcomeResultTypes+    outcomeBehaviorImports = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just _ ->+        ["import " <> (.genPrefix) aggregate <> ".EventStream (" <> handlerName <> ")"]+          <> [ "import "+                 <> generatedNominalModule ((.context) aggregate)+                 <> " ("+                 <> T.intercalate ", " (map (.name) (stableNominals outcomeGeneratedNominals))+                 <> ")"+             | not (null outcomeGeneratedNominals)+             ]+          <> T.lines (renderPlannedImports outcomeImportPlan)+          <> ["import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))"]+    outcomeExpectationConstructors = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just outcomeTypes ->+        [ "  | RejectedWith " <> renderDomainType outcomeImportPlan aggregate ((.rejectionType) outcomeTypes),+          "  | NoOpWith " <> renderDomainType outcomeImportPlan aggregate ((.noOpType) outcomeTypes)+        ]+    outcomeGenericRejectionCases = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just _ ->+        [ "  RejectedWith _ -> failure requirement \"expectation-kind\" \"an unmatched-command rejection cannot expect a selected domain rejection\"",+          "  NoOpWith _ -> failure requirement \"expectation-kind\" \"an unmatched-command rejection cannot expect a selected domain no-op\""+        ]+    genericNoOpAcceptanceLines = case (.domainOutcomeTypes) aggregate of+      Just _ -> ["  NoOp -> failure requirement \"expectation-kind\" \"an outcome-enabled transition requires RejectedWith or NoOpWith exact reason evidence\""]+      Nothing ->+        [ "  NoOp -> case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",+          "    Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",+          "    Right success -> do",+          "      checkAcceptedEnvelope requirement success",+          "      ensure requirement (null (K.stepSuccessOutputs success)) \"noop-emitted\" \"NoOp emitted one or more events\"",+          "      ensure requirement (K.stepSuccessState success == fst seed) \"noop-vertex-change\" \"NoOp changed the control vertex\"",+          "      ensure requirement (regsEqual (K.stepSuccessRegs success) (snd seed)) \"noop-register-change\" \"NoOp changed one or more registers\""+        ]+    outcomeExactAcceptanceCases = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just _ ->+        [ "  RejectedWith expectedReason -> do",+          "    decision <- runSilentDecision requirement seed command",+          "    case decision of",+          "      SilentRejected actualReason -> ensure requirement (actualReason == expectedReason) \"domain-rejection-reason\" (\"selected rejection reason differs; actual=\" <> tshow actualReason <> \" expected=\" <> tshow expectedReason)",+          "      SilentNoOp actualReason -> failure requirement \"domain-outcome-kind\" (\"expected a selected rejection but classifier returned no-op \" <> tshow actualReason)",+          "  NoOpWith expectedReason -> do",+          "    decision <- runSilentDecision requirement seed command",+          "    case decision of",+          "      SilentRejected actualReason -> failure requirement \"domain-outcome-kind\" (\"expected a selected no-op but classifier returned rejection \" <> tshow actualReason)",+          "      SilentNoOp actualReason -> ensure requirement (actualReason == expectedReason) \"domain-noop-reason\" (\"selected no-op reason differs; actual=\" <> tshow actualReason <> \" expected=\" <> tshow expectedReason)"+        ]+    outcomeSilentRunnerLines = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just outcomeTypes ->+        [ "",+          "runSilentDecision",+          "  :: BehaviorRequirement",+          "  -> (" <> (.vertexType) aggregate <> ", K.RegFile " <> name <> "Regs)",+          "  -> " <> name <> "Command",+          "  -> Either BehaviorFailure (SilentDomainDecision " <> renderDomainType outcomeImportPlan aggregate ((.rejectionType) outcomeTypes) <> " " <> renderDomainType outcomeImportPlan aggregate ((.noOpType) outcomeTypes) <> ")",+          "runSilentDecision requirement seed command = case K.stepDetailedEither " <> valueStem <> "Transducer seed command of",+          "  Left stepFailure -> failure requirement \"unexpected-rejection\" (tshow stepFailure)",+          "  Right success -> do",+          "    checkAcceptedEnvelope requirement success",+          "    ensure requirement (null (K.stepSuccessOutputs success)) \"silent-emitted\" \"typed silent outcome emitted one or more events\"",+          "    ensure requirement (K.stepSuccessState success == fst seed) \"silent-vertex-change\" \"typed silent outcome changed the control vertex\"",+          "    ensure requirement (regsEqual (K.stepSuccessRegs success) (snd seed)) \"silent-register-change\" \"typed silent outcome changed one or more registers\"",+          "    case " <> handlerName <> " of",+          "      DomainCommandHandler _ classify ->",+          "        Right (classify (SilentCommandContext (fst seed) (snd seed) command (K.stepSuccessEdge success)))"+        ]+    behaviorCoreImports =+      [ "EdgeMode (..)",+        "EdgeRef (..)",+        "RegFile",+        "ReplayAttribution (..)",+        "ReplayEventSpan (..)",+        "ReplaySuccess (..)",+        "StepFailure (..)",+        "StepSuccess (..)",+        "applyEventsDetailedEither",+        "stepDetailedEither"+      ]+        <> ["(!)" | not (null ((.regs) aggregate))]++renderCommandKind :: Agg -> [Text]+renderCommandKind aggregate = case (.commands) aggregate of+  [] -> ["", "commandKind :: " <> (.name) aggregate <> "Command -> Text", "commandKind _ = \"\""]+  commands ->+    [ "",+      "commandKind :: " <> (.name) aggregate <> "Command -> Text",+      "commandKind command = case command of"+    ]+      <> ["  " <> (.name) command <> " _ -> " <> tshow ((.name) command) | command <- commands]++renderBehaviorRequirementList :: Agg -> [Text]+renderBehaviorRequirementList aggregate =+  case behaviorRequirementsFor aggregate of+    [] -> ["  []"]+    requirements ->+      concat+        [ render index requirement+        | (index, requirement) <- zip [0 ..] requirements+        ]+        <> ["  ]"]+  where+    render index requirement =+      [ (if index == (0 :: Int) then "  [ -- " else "  , -- ") <> behaviorRequirementLabel aggregate requirement,+        "    BehaviorRequirement",+        "      { requirementKey = BehaviorKey " <> tshow (Behavior.unBehaviorKey ((.key) requirement)),+        "      , requirementKind = " <> T.pack (show ((.kind) requirement)),+        "      , requirementEvidence = " <> T.pack (show ((.evidence) requirement)),+        "      , requirementGuardCoverage = " <> T.pack (show ((.guardCoverage) requirement)),+        "      , requirementSource = " <> vertexCtor aggregate ((.source) requirement),+        "      , requirementCommandName = " <> tshow ((.command) requirement),+        "      , requirementExpectedEdge = " <> edgeExpr aggregate requirement,+        "      , requirementTarget = " <> maybe "Nothing" (\target -> "Just " <> vertexCtor aggregate target) ((.target) requirement),+        "      , requirementEventKinds = " <> renderBehaviorTextList ((.events) requirement),+        "      }"+      ]++behaviorRequirementLabel :: Agg -> Behavior.BehaviorRequirement -> Text+behaviorRequirementLabel aggregate requirement =+  vertexCtor aggregate ((.source) requirement)+    <> " x "+    <> (.command) requirement+    <> ": "+    <> ( case (.kind) requirement of+           Behavior.LiveTransition -> "live transition"+           Behavior.RequiredRejection -> "required rejection"+           Behavior.ReplayTransition -> "replay-only transition"+       )++edgeExpr :: Agg -> Behavior.BehaviorRequirement -> Text+edgeExpr aggregate requirement = case (.kind) requirement of+  Behavior.RequiredRejection -> "Nothing"+  _ -> case behaviorEdgeIndex aggregate requirement of+    Nothing -> error ("required behavior transition missing from resolved aggregate: " <> T.unpack ((.canonical) requirement))+    Just edgeIndex ->+      "(Just (K.EdgeRef "+        <> vertexCtor aggregate ((.source) requirement)+        <> " "+        <> tshow' edgeIndex+        <> "))"++behaviorEdgeIndex :: Agg -> Behavior.BehaviorRequirement -> Maybe Int+behaviorEdgeIndex aggregate requirement = case (.origin) requirement of+  Behavior.RejectionRequirementOrigin {} -> Nothing+  Behavior.TransitionRequirementOrigin originAggregate (SourceIndex.TransitionOrdinal ordinal) -> do+    transition <- case drop ordinal ((.transitions) aggregate) of+      candidate : _ -> Just candidate+      [] -> Nothing+    if originAggregate == (.name) aggregate+      && (.source) transition == (.source) requirement+      && (.command) transition == (.command) requirement+      then+        Just+          ( length+              [ ()+              | candidate <- take ordinal ((.transitions) aggregate),+                (.source) candidate == (.source) transition+              ]+          )+      else Nothing++behaviorRequirementsFor :: Agg -> [Behavior.BehaviorRequirement]+behaviorRequirementsFor aggregate =+  case Behavior.deriveAggregateBehaviorRequirements ((.spec) aggregate) ((.aggregate) aggregate) of+    Left derivationError -> error ("validated aggregate failed behavior derivation: " <> show derivationError)+    Right requirements -> sortOn (.key) requirements++renderBehaviorTextList :: [Text] -> Text+renderBehaviorTextList values = "[" <> T.intercalate ", " (map tshow values) <> "]"++regsEqualityExpression :: Agg -> Text+regsEqualityExpression aggregate = case (.regs) aggregate of+  [] -> "regsEqual _ _ = True"+  registers ->+    "regsEqual left right = "+      <> T.intercalate+        " && "+        [ "(left K.! #" <> (.name) register <> ") == (right K.! #" <> (.name) register <> ")"+        | register <- registers+        ]++behaviorHoleModule :: Agg -> ScaffoldModule+behaviorHoleModule aggregate =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" ((.holePrefix) aggregate) <> "/BehaviorHoles.hs"),+      text = emitBehaviorHoles aggregate,+      kind = HoleStub,+      origin = nodeOrigin "aggregate behavior witnesses" ((.name) aggregate) ((.loc) aggregate)+    }++emitBehaviorHoles :: Agg -> Text+emitBehaviorHoles aggregate =+  nl $+    [ "-- Consumer-owned behavioral witnesses. Created once; never overwritten.",+      "module " <> (.holePrefix) aggregate <> ".BehaviorHoles (behaviorWitnesses) where",+      "",+      "import " <> (.genPrefix) aggregate <> ".BehaviorContract",+      "",+      "behaviorWitnesses :: [BehaviorWitness]",+      "behaviorWitnesses ="+    ]+      <> case behaviorRequirementsFor aggregate of+        [] -> ["  []"]+        requirements ->+          [ (if index == (0 :: Int) then "  [ " else "  , ")+              <> "Pending (BehaviorKey "+              <> tshow (Behavior.unBehaviorKey ((.key) requirement))+              <> ") -- "+              <> behaviorRequirementLabel aggregate requirement+          | (index, requirement) <- zip [0 ..] requirements+          ]+            <> ["  ]"]++-- | Emit the context-wide replay-audit target assembly.+--+-- There is one existential target per aggregate declaration. Process saga+-- aggregates are ordinary aggregate nodes referenced by 'SagaRef', so they are+-- included by the same single source of truth rather than being duplicated from+-- the process declaration.+scaffoldReplayAudit :: Context -> Spec -> [ScaffoldModule]+scaffoldReplayAudit ctx spec+  | null aggregates = []+  | otherwise =+      [ ScaffoldModule+          { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+            text = emitReplayAudit,+            kind = Generated,+            origin = "context " <> (.context) spec <> " replay-audit assembly"+          }+      ]+  where+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    moduleName = contextGeneratedPrefix ctx <> ".ReplayAudit"+    emitReplayAudit =+      nl $+        renderGeneratedLanguagePragmas []+          <> [ generatedBanner,+               "--",+               "-- Deployment contract:",+               "--   * replay-neutral diff: no data audit is required;",+               "--   * affected diff: run AuditTargeted with the emitted affected set",+               "--     against a production copy under the candidate binary;",+               "--   * one-time runtime cutover: run AuditFull;",+               "--   * any non-zero audit exit blocks deployment.",+               "module " <> moduleName <> " (auditTargets) where",+               ""+             ]+          ++ [ "import " <> genPrefixFor ctx ((.name) aggregate) <> ".EventStream qualified as " <> (.name) aggregate+             | aggregate <- aggregates+             ]+          ++ [ "import Keiro.ReplayAudit (AuditTarget (..), SomeAuditTarget (..), streamInCategory)",+               "import Keiro.Stream qualified as Stream",+               "",+               "auditTargets :: [SomeAuditTarget]",+               "auditTargets ="+             ]+          ++ concat+            [ [ if index == (0 :: Int) then "  [ SomeAuditTarget" else "  , SomeAuditTarget",+                "      AuditTarget",+                "        { eventStream = " <> aggregateName <> "." <> lowerFirst aggregateName <> "EventStream",+                "        , category = Stream.categoryText " <> aggregateName <> "." <> lowerFirst aggregateName <> "Category",+                "        , mkStream = streamInCategory (Stream.categoryText " <> aggregateName <> "." <> lowerFirst aggregateName <> "Category)",+                "        }"+              ]+            | (index, aggregate) <- zip [0 ..] aggregates,+              let aggregateName = (.name) aggregate+            ]+          ++ ["  ]"]++genModule :: Agg -> Text -> Text -> ScaffoldModule+genModule a name body =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" ((.genPrefix) a) <> "/" <> name <> ".hs"),+      text = body,+      kind = Generated,+      origin = nodeOrigin "aggregate" ((.name) a) ((.loc) a)+    }++holeModule :: Agg -> Text -> ScaffoldModule+holeModule a body =+  ScaffoldModule+    { path = T.unpack (T.replace "." "/" ((.holePrefix) a) <> "/" <> "Holes.hs"),+      text = body,+      kind = HoleStub,+      origin = nodeOrigin "aggregate" ((.name) a) ((.loc) a)+    }++--------------------------------------------------------------------------------+-- Integration contract (EP-4): a self-contained payload ADT + codec+--------------------------------------------------------------------------------++-- | Emit the deterministic, symbol-free contract layer: a payload ADT+-- (per-event records), the topic constants, the @messageType@ discriminator, and a+-- strict encode\/decode keyed by it. Self-contained (base\/text\/aeson), so it+-- compiles standalone — the cross-service schema both producer and consumer agree+-- on. No keiki symbolic operator (firewall holds).+scaffoldContract :: Context -> ContractNode -> [ScaffoldModule]+scaffoldContract ctx = scaffoldContractWithLanguage ctx (effectiveLanguageContract LegacyUnversioned)++-- | Emit a contract under the checked service's released semantic contract.+-- Language versions 1 through 3 retain the legacy Text representation; only+-- runtime semantics 3 lowers declared TypeID fields to prefix-indexed KindIDs.+scaffoldContractForService :: Context -> CheckedService -> ContractNode -> [ScaffoldModule]+scaffoldContractForService ctx service = scaffoldContractWithLanguage ctx (checkedLanguageContract service)++scaffoldContractWithLanguage :: Context -> EffectiveLanguageContract -> ContractNode -> [ScaffoldModule]+scaffoldContractWithLanguage ctx languageContract c =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Contract.hs"),+        text = emitContractGen languageContract genPrefix c,+        kind = Generated,+        origin = nodeOrigin "contract" ((.name) c) ((.loc) c)+      }+  ]+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) c))++emitContractGen :: EffectiveLanguageContract -> Text -> ContractNode -> Text+emitContractGen languageContract genPrefix c =+  ( nl $+      pragmas+        ++ [generatedBanner]+        ++ moduleHeader+        ++ [ "",+             -- A typed-TypeID field decodes through explicitParseField, so a+             -- contract whose every field is one never uses (.:) and would warn+             -- under -Wunused-imports.+             "import Data.Aeson ("+               <> T.intercalate ", " (["Value", "object", "withObject", "withText"] <> ["(.:)" | usesPlainFieldDecode] <> ["(.=)"])+               <> ")",+             aesonTypesImport+           ]+        ++ typedKindIdImports+        ++ [ "import Data.Text (Text)",+             "import qualified Data.Text as T"+           ]+        ++ ["import Keiro.Codec.IdDomain (parseKindIdV7Value)" | hasTypedTypeIds]+        ++ [ "",+             "-- topic constants"+           ]+        ++ topicConstants+        ++ [ "",+             "-- the closed payload set (discriminated by " <> tshow ((.discriminator) c) <> ")"+           ]+        ++ [emitPayloadAdt languageContract payloadTy ((.events) c)]+        ++ [ "",+             "messageTypeOf :: " <> payloadTy <> " -> Text",+             "messageTypeOf = \\case"+           ]+        ++ ["  " <> (.name) e <> " {} -> " <> tshow ((.name) e) | e <- (.events) c]+        ++ [ "",+             "encode" <> payloadTy <> " :: " <> payloadTy <> " -> Value",+             "encode" <> payloadTy <> " = \\case"+           ]+        ++ concatMap encodeArm ((.events) c)+        ++ [ "",+             "parse" <> payloadTy <> " :: Value -> Either Text " <> payloadTy,+             "parse" <> payloadTy <> " = mapLeftText . parseEither (withObject " <> tshow payloadTy <> " go)",+             "  where",+             "    go o = do",+             "      kind <- explicitParseField (withText " <> tshow ((.discriminator) c) <> " validateMessageType) o " <> tshow ((.discriminator) c),+             "      case kind of"+           ]+        ++ concatMap decodeArm ((.events) c)+        ++ [ "        _ -> fail \"validated message type was not handled\"",+             "",+             "mapLeftText :: Either String b -> Either Text b",+             "mapLeftText = either (Left . T.pack) Right",+             "",+             "validateMessageType :: Text -> Parser Text",+             "validateMessageType kind",+             "  | kind `elem` " <> renderTextList (map (.name) ((.events) c)) <> " = pure kind",+             "  | otherwise = " <> renderUnknownFailure "message type" "kind" (map (.name) ((.events) c))+           ]+  )+    <> if hasTypedTypeIds then "\n" else ""+  where+    payloadTy = pascal ((.name) c) <> "Payload"+    hasTypedTypeIds = any (any (isTypedTypeId . (.valueType)) . (.fields)) ((.events) c)+    usesPlainFieldDecode = any (any (not . isTypedTypeId . (.valueType)) . (.fields)) ((.events) c)+    pragmas =+      renderGeneratedLanguagePragmas+        ( [ExtDuplicateRecordFields | contractNeedsDuplicateRecordFields c]+            <> [ExtOverloadedRecordDot | contractUsesRecordDot c]+        )+    typedKindIdImports+      | hasTypedTypeIds = ["import Data.KindID (KindID)", "import qualified Data.KindID as KindID"]+      | otherwise = []+    moduleHeader =+      [ "module " <> genPrefix <> ".Contract",+        "  ( " <> payloadTy <> " (..)"+      ]+        ++ ["  , " <> (.name) event <> "Data (..)" | event <- (.events) c]+        ++ ["  , " <> lowerFirst alias <> "Topic" | (alias, _) <- (.topics) c]+        ++ [ "  , messageTypeOf",+             "  , encode" <> payloadTy,+             "  , parse" <> payloadTy,+             "  ) where"+           ]+    topicConstants+      | hasTypedTypeIds =+          [ T.intercalate+              "\n\n"+              [lowerFirst alias <> "Topic :: Text\n" <> lowerFirst alias <> "Topic = " <> tshow topic | (alias, topic) <- (.topics) c]+          ]+      | otherwise = [lowerFirst alias <> "Topic :: Text\n" <> lowerFirst alias <> "Topic = " <> tshow topic | (alias, topic) <- (.topics) c]+    isTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)+    isTypedTypeId _ = False+    aesonTypesImport = "import Data.Aeson.Types (Parser, explicitParseField, parseEither)"+    encodeArm e =+      [ "  " <> (.name) e <> " payload ->",+        "    object"+      ]+        ++ objectEntriesFor ((tshow ((.discriminator) c) <> " .= (" <> tshow ((.name) e) <> " :: Text)") : map encodeField ((.fields) e))+        ++ ["      ]"]+    lead 0 kv = "      [ " <> kv+    lead _ kv = "      , " <> kv+    objectEntriesFor entries+      | hasTypedTypeIds =+          [ (if index == 0 then "      [ " else "        ")+              <> entry+              <> if index < length entries - 1 then "," else ""+          | (index, entry) <- zip [(0 :: Int) ..] entries+          ]+      | otherwise = [lead index entry | (index, entry) <- zip [(0 :: Int) ..] entries]+    decodeArm e =+      ["        " <> tshow ((.name) e) <> " ->"]+        ++ case (.fields) e of+          [] -> ["          pure (" <> (.name) e <> " " <> (.name) e <> "Data)"]+          fields ->+            [ "          " <> (.name) e,+              "            <$> ( " <> (.name) e <> "Data"+            ]+              ++ [ (if index == 0 then "                    <$> " else "                    <*> ") <> decodeField field+                 | (index, field) <- zip [(0 :: Int) ..] fields+                 ]+              ++ ["                )"]+    encodeField field =+      tshow ((.wireKey) identity)+        <> " .= "+        <> case (.valueType) field of+          CTypeId prefix+            | isJust (contractIdDomainContractFor languageContract prefix) -> "KindID.toText payload." <> (.selector) identity+          _ -> "payload." <> (.selector) identity+      where+        identity = resolveContractFieldIdentity field+    decodeField field = case (.valueType) field of+      CTypeId prefix+        | isJust (contractIdDomainContractFor languageContract prefix) ->+            "explicitParseField (parseKindIdV7Value @" <> tshow prefix <> ") o " <> tshow wireKey+      _ -> "o .: " <> tshow wireKey+      where+        wireKey = (.wireKey) (resolveContractFieldIdentity field)++contractNeedsDuplicateRecordFields :: ContractNode -> Bool+contractNeedsDuplicateRecordFields = hasDuplicateNames . concatMap (map ((.selector) . resolveContractFieldIdentity) . (.fields)) . (.events)++contractUsesRecordDot :: ContractNode -> Bool+contractUsesRecordDot = any (not . null . (.fields)) . (.events)++emitPayloadAdt :: EffectiveLanguageContract -> Text -> [ContractEvent] -> Text+emitPayloadAdt languageContract tyName events =+  sectionsOf [map dataRecord events, [sumDecl]]+  where+    hasTypedTypeIds = any (any (isTypedTypeId . (.valueType)) . (.fields)) events+    isTypedTypeId (CTypeId prefix) = isJust (contractIdDomainContractFor languageContract prefix)+    isTypedTypeId _ = False+    valueType CText = "Text"+    valueType CInt = "Int"+    valueType (CTypeId prefix)+      | isJust (contractIdDomainContractFor languageContract prefix) = "(KindID " <> tshow prefix <> ")"+      | otherwise = "Text"+    dataRecord e =+      "data "+        <> (.name) e+        <> "Data = "+        <> (.name) e+        <> (if hasTypedTypeIds then "Data {" else "Data { ")+        <> T.intercalate ", " [(.selector) (resolveContractFieldIdentity f) <> " :: !" <> valueType ((.valueType) f) | f <- (.fields) e]+        <> (if hasTypedTypeIds then "}\n  deriving stock (Eq, Show)" else " }\n  deriving stock (Eq, Show)")+    arm e = (.name) e <> " !" <> (.name) e <> "Data"+    sumDecl = case events of+      [] -> "data " <> tyName <> " = " <> tyName <> "Empty\n  deriving stock (Eq, Show)"+      (e : es) ->+        nl+          ( (if hasTypedTypeIds then ["data " <> tyName, "  = " <> arm e] else ["data " <> tyName <> " = " <> arm e])+              ++ ["  | " <> arm e2 | e2 <- es]+              ++ ["  deriving stock (Eq, Show)"]+          )++--------------------------------------------------------------------------------+-- Integration intake (EP-4): inbox disposition vs the live Keiro.Inbox runtime+--------------------------------------------------------------------------------++-- | Emit the inbox node's deterministic disposition wiring compiled against the+-- LIVE @Keiro.Inbox.Types@: the dedupe policy (a real 'InboxDedupePolicy') and a+-- disposition function over the real @InboxResult@ (including handler+-- failures). This pins the dangerous inversions+-- (duplicate ⇒ ackOk, previouslyFailed ⇒ deadLetter) as compiled code over the+-- runtime types. The complete declared classification table is also available+-- to handler holes through a closed generated outcome type. Firewall holds (no+-- keiki symbolic operator).+scaffoldIntake :: Context -> IntakeNode -> [ScaffoldModule]+scaffoldIntake ctx i =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Inbox.hs"),+        text = emitIntakeGen genPrefix i,+        kind = Generated,+        origin = nodeOrigin "intake" ((.name) i) ((.loc) i)+      }+  ]+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) i))++emitIntakeGen :: Text -> IntakeNode -> Text+emitIntakeGen genPrefix i =+  nl $+    renderGeneratedLanguagePragmas []+      <> [ generatedBanner,+           "module " <> genPrefix <> ".Inbox",+           "  ( InboxFailure (..)",+           "  , " <> outcomeType <> " (..)",+           "  , " <> dispositionType <> " (..)",+           "  , inboxDedupePolicy",+           "  , inboxPersistence",+           "  , inboxDispositionFor",+           "  , inboxDisposition",+           "  ) where",+           "",+           "import Data.Text (Text)",+           "import Keiro.Inbox.Types (InboxDedupePolicy (..), InboxPersistence (..), InboxResult (..), RetryDelay (..))",+           "",+           "-- The dedupe policy (hole-kind 4), lowered to the live InboxDedupePolicy.",+           "inboxDedupePolicy :: InboxDedupePolicy",+           "inboxDedupePolicy = " <> (.dedupePolicy) i,+           "",+           "-- | Success-path envelope retention passed to runInboxTransactionWith.",+           "-- Failures always retain their full operator-facing dead-letter envelope.",+           "-- Dedupe-only success rows decode with an empty payload.",+           "inboxPersistence :: InboxPersistence",+           "inboxPersistence = " <> persistenceCtor ((.persist) i),+           "",+           "-- Runtime failure detail retained when the inbox wrapper reports a failed handler attempt.",+           "data InboxFailure = InboxFailure",+           "  { inboxFailureReason :: !Text",+           "  , inboxFailureAttempt :: !(Maybe Int)",+           "  }",+           "  deriving stock (Eq, Show)",+           "",+           "-- Every classification named by the spec. Keeping this closed makes the",+           "-- generated table exhaustive and gives handler holes typed inputs.",+           "data " <> outcomeType,+           "  = " <> T.intercalate "\n  | " outcomeConstructors,+           "  deriving stock (Eq, Show)",+           "",+           "-- The service's declared acknowledgement decision, including its details.",+           "data " <> dispositionType,+           "  = InboxAccept",+           "  | InboxRetryAfter !RetryDelay !(Maybe InboxFailure)",+           "  | InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)",+           "  deriving stock (Eq, Show)",+           "",+           "-- The complete disposition table (hole-kind 2).",+           "inboxDispositionFor :: " <> outcomeType <> " -> " <> dispositionType,+           "inboxDispositionFor outcome = case outcome of"+         ]+      ++ ["  " <> outcomeConstructor ((.outcome) row) <> " -> " <> actionExpression ((.action) row) | row <- (.disposition) i]+      ++ [ "",+           "-- Lower the LIVE Keiro.Inbox.Types.InboxResult without an open fallback.",+           "inboxDisposition :: InboxResult a -> " <> dispositionType,+           "inboxDisposition r = case r of",+           "  InboxProcessed _ -> inboxDispositionFor " <> outcomeConstructor "processed",+           "  InboxDuplicate -> inboxDispositionFor " <> outcomeConstructor "duplicate",+           "  InboxInProgress -> inboxDispositionFor " <> outcomeConstructor "inProgress",+           "  InboxPreviouslyFailed failureReason ->",+           "    maybe (inboxDispositionFor " <> outcomeConstructor "previouslyFailed" <> ")",+           "      (\\reason -> attachFailure (InboxFailure reason Nothing) (inboxDispositionFor " <> outcomeConstructor "previouslyFailed" <> "))",+           "      failureReason",+           "  InboxHandlerFailed reason attempts ->",+           "    attachFailure (InboxFailure reason (Just attempts)) (inboxDispositionFor " <> outcomeConstructor "storeFailed" <> ")",+           "",+           "attachFailure :: InboxFailure -> " <> dispositionType <> " -> " <> dispositionType,+           "attachFailure failure disposition = case disposition of",+           "  InboxRetryAfter delay _ -> InboxRetryAfter delay (Just failure)",+           "  InboxDeadLetter reason _ -> InboxDeadLetter reason (Just failure)",+           "  InboxAccept -> InboxAccept"+         ]+  where+    stem = pascal ((.name) i)+    outcomeType = stem <> "Outcome"+    dispositionType = stem <> "Disposition"+    outcomeConstructor = (stem <>) . pascal+    outcomeConstructors = map (outcomeConstructor . (.outcome)) ((.disposition) i)+    actionExpression IAckOk = "InboxAccept"+    actionExpression (IRetry win) = "InboxRetryAfter (RetryDelay " <> windowText win <> ") Nothing"+    actionExpression (IDeadLetter mr) = "InboxDeadLetter " <> maybe "Nothing" (\reason -> "(Just " <> tshow reason <> ")") mr <> " Nothing"+    persistenceCtor InkPersistFull = "PersistFullEnvelope"+    persistenceCtor InkPersistDedupeOnly = "PersistDedupeOnly"++--------------------------------------------------------------------------------+-- Integration publisher (EP-4): config vs the live Keiro.Outbox runtime+--------------------------------------------------------------------------------++-- | Emit the publisher's at-least-once policy compiled against the LIVE+-- @Keiro.Outbox.Types@: the ordering policy (a real 'OrderingPolicy'), the backoff+-- curve (a real 'BackoffSchedule'), and the max-attempts ceiling. Firewall holds.+scaffoldPublisher :: Context -> PublisherNode -> [ScaffoldModule]+scaffoldPublisher ctx pb =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Publisher.hs"),+        text = emitPublisherGen genPrefix pb,+        kind = Generated,+        origin = nodeOrigin "publisher" ((.name) pb) ((.loc) pb)+      }+  ]+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) pb))++emitPublisherGen :: Text -> PublisherNode -> Text+emitPublisherGen genPrefix pb =+  nl+    [ generatedBanner,+      "module " <> genPrefix <> ".Publisher",+      "  ( publisherOrdering",+      "  , publisherBackoff",+      "  , publisherMaxAttempts",+      "  ) where",+      "",+      -- Only an exponential schedule mentions ExponentialBackoffOptions, and an+      -- unconditional import makes a constant-backoff publisher warn under+      -- -Wunused-imports. Generated code compiles under -Werror.+      "import Keiro.Outbox.Types (BackoffSchedule (..), OrderingPolicy (..)"+        <> (if (.kind) ((.backoff) pb) == "exponential" then ", ExponentialBackoffOptions (..)" else "")+        <> ")",+      "",+      "publisherOrdering :: OrderingPolicy",+      "publisherOrdering = " <> (.ordering) pb,+      "",+      "publisherBackoff :: BackoffSchedule",+      "publisherBackoff = " <> backoffExpr ((.backoff) pb),+      "",+      "publisherMaxAttempts :: Int",+      "publisherMaxAttempts = " <> tshow' ((.maxAttempts) pb)+    ]+  where+    backoffExpr b = case (.kind) b of+      "constant" -> "ConstantBackoff " <> windowText ((.window) b)+      "exponential" ->+        "ExponentialBackoff ExponentialBackoffOptions { initial = "+          <> windowText ((.window) b)+          <> ", maxDelay = "+          <> maybe "0" windowText ((.max) b)+          <> ", multiplier = "+          <> fromMaybe "0" ((.multiplier) b)+          <> " }"+      _ -> "error \"keiro-dsl: unlowerable backoff kind\""++--------------------------------------------------------------------------------+-- pgmq workqueue (EP-5): a self-contained Job payload record + codec+--------------------------------------------------------------------------------++-- | Emit the deterministic, symbol-free pgmq layer: the Job payload record, the+-- field→wire-name JSON codec, and the captured physical\/dlq\/table name constants.+-- Self-contained (base\/text\/aeson). The fan-out body and the raw-SQL dedup+-- predicate are holes (not emitted). Firewall holds.+scaffoldWorkqueue :: Context -> WorkqueueNode -> [ScaffoldModule]+scaffoldWorkqueue ctx w =+  scaffoldWorkqueueWithQueueText ctx w (emitWorkqueueGen genPrefix w)+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) w))++-- | Service-aware workqueue generation resolves candidate type expressions+-- against the checked graph. Legacy scalar workqueues deliberately stay on+-- 'emitWorkqueueGen' so their generated bytes cannot drift.+scaffoldWorkqueueForService :: Context -> CheckedService -> WorkqueueNode -> [ScaffoldModule]+scaffoldWorkqueueForService ctx service workqueue =+  scaffoldWorkqueueWithQueueText ctx workqueue queueText+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) workqueue))+    queueText+      | any isTypedQueueField ((.payload) workqueue) =+          case checkedTypeGraph service of+            Left errors -> error ("checked workqueue type graph failed: " <> show errors)+            Right graph -> emitMappedWorkqueueGen ctx genPrefix graph workqueue+      | otherwise = emitWorkqueueGen genPrefix workqueue++scaffoldWorkqueueWithQueueText :: Context -> WorkqueueNode -> Text -> [ScaffoldModule]+scaffoldWorkqueueWithQueueText ctx w queueText =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Queue.hs"),+        text = queueText,+        kind = Generated,+        origin = nodeOrigin "workqueue" ((.name) w) ((.loc) w)+      },+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/QueuePolicy.hs"),+        text = emitQueuePolicy genPrefix w,+        kind = Generated,+        origin = nodeOrigin "workqueue" ((.name) w) ((.loc) w)+      },+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/QueueCodec.hs"),+        text = emitQueueCodec genPrefix w,+        kind = Generated,+        origin = nodeOrigin "workqueue" ((.name) w) ((.loc) w)+      }+  ]+  where+    genPrefix = genPrefixFor ctx (pascal ((.name) w))++isTypedQueueField :: WqField -> Bool+isTypedQueueField field = case (.valueType) field of+  LegacyQueueScalar {} -> False+  TypedQueueExpression {} -> True++emitWorkqueueGen :: Text -> WorkqueueNode -> Text+emitWorkqueueGen genPrefix w =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | workqueueUsesRecordDot w]+      <> [ generatedBanner,+           "module " <> genPrefix <> ".Queue",+           "  ( " <> payloadTy <> " (..)",+           "  , encode" <> payloadTy,+           "  , parse" <> payloadTy,+           "  , queuePhysical, queueDlq, queueTable",+           groupKeyExport,+           "  ) where",+           "",+           "import Data.Aeson (Value, object, withObject, (.:), (.=))",+           "import Data.Aeson.Types (parseEither)",+           "import Data.Text (Text)",+           "import qualified Data.Text as T",+           "",+           "queuePhysical, queueDlq, queueTable :: Text",+           "queuePhysical = " <> tshow ((.physical) w),+           "queueDlq = " <> tshow ((.dlq) w),+           "queueTable = " <> tshow ((.table) w),+           ""+         ]+      ++ groupKeyLines+      ++ [ "data " <> payloadTy <> " = " <> payloadTy,+           "  { " <> T.intercalate "\n  , " [(.name) f <> " :: !" <> payloadFieldType f | f <- (.payload) w],+           "  }",+           "  deriving stock (Eq, Show)",+           "",+           "encode" <> payloadTy <> " :: " <> payloadTy <> " -> Value",+           "encode" <> payloadTy <> " p =",+           "  object"+         ]+      ++ [lead i (tshow ((.wire) f) <> " .= p." <> (.name) f) | (i, f) <- zip [(0 :: Int) ..] ((.payload) w)]+      ++ [ "    ]",+           "",+           "parse" <> payloadTy <> " :: Value -> Either Text " <> payloadTy,+           "parse" <> payloadTy <> " = mapLeftText . parseEither (withObject " <> tshow payloadTy <> " go)",+           "  where",+           "    go o = " <> payloadTy <> fieldApps ((.payload) w),+           "",+           "mapLeftText :: Either String b -> Either Text b",+           "mapLeftText = either (Left . T.pack) Right"+         ]+  where+    payloadTy = (.payloadName) w+    payloadFieldType field = case (.valueType) field of+      LegacyQueueScalar scalar -> valueType (queueScalarName scalar)+      TypedQueueExpression _ -> error "keiro-dsl internal invariant: mapped queue lowering is pending"+    groupKeyExport = case (.groupKey) w of+      Nothing -> ""+      Just groupKey+        | (.via) groupKey == "raw" -> "  , groupKeyField, groupKeyFor"+        | otherwise -> "  , groupKeyField"+    groupKeyLines = case (.groupKey) w of+      Nothing -> []+      Just groupKey -> common <> derivationLines groupKey+        where+          common =+            [ "groupKeyField :: Text",+              "groupKeyField = " <> tshow ((.field) groupKey),+              ""+            ]+          derivationLines key+            | (.via) key == "raw" =+                [ "groupKeyFor :: " <> payloadTy <> " -> Text",+                  "groupKeyFor payload = payload." <> (.field) key,+                  ""+                ]+            | otherwise =+                [ "-- Opaque group-key derivation '" <> (.via) key <> "' remains hand-owned.",+                  "-- Captured fixture: " <> fromMaybe "<missing>" ((.fixture) key),+                  ""+                ]+    valueType "bool" = "Bool"+    valueType "int" = "Int"+    valueType _ = "Text"+    lead 0 kv = "    [ " <> kv+    lead _ kv = "    , " <> kv+    fieldApps [] = ""+    fieldApps fs = " <$> " <> T.intercalate " <*> " ["o .: " <> tshow ((.wire) f) | f <- fs]++data ResolvedQueueField = ResolvedQueueField+  { field :: !WqField,+    expression :: !(Maybe ResolvedTypeExpr),+    codecPlan :: !(Maybe MappedCodecPlan)+  }++emitMappedWorkqueueGen :: Context -> Text -> TypeGraph -> WorkqueueNode -> Text+emitMappedWorkqueueGen ctx genPrefix graph workqueue =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | workqueueUsesRecordDot workqueue]+      <> [ generatedBanner,+           "module " <> genPrefix <> ".Queue",+           "  ( " <> payloadType <> " (..)",+           "  , encode" <> payloadType,+           "  , parse" <> payloadType+         ]+      <> concatMap mappedCodecExports structuralDeclarations+      <> [ "  , queuePhysical, queueDlq, queueTable",+           groupKeyExport,+           "  ) where",+           ""+         ]+      <> mappedQueueImports+      <> [ "",+           "queuePhysical, queueDlq, queueTable :: Text",+           "queuePhysical = " <> tshow ((.physical) workqueue),+           "queueDlq = " <> tshow ((.dlq) workqueue),+           "queueTable = " <> tshow ((.table) workqueue),+           ""+         ]+      <> groupKeyLines+      <> [ "data " <> payloadType <> " = " <> payloadType,+           "  { " <> T.intercalate "\n  , " [(.name) raw <> " :: " <> strictQueueFieldType (queueFieldType field) | field@ResolvedQueueField {field = raw} <- fields],+           "  }",+           "  deriving stock (Eq, Show)",+           ""+         ]+      <> (if hasStructural then [T.intercalate "\n\n" [emitStructuralCodec importPlan ctx graph declaration shape | ResolvedStructural declaration shape <- declarations], ""] else [])+      <> [ "encode" <> payloadType <> " :: " <> payloadType <> " -> Value",+           "encode" <> payloadType <> " payload =",+           "  object"+         ]+      <> [queueLead index (tshow ((.wire) raw) <> " .= " <> encodeQueueField field) | (index, field@ResolvedQueueField {field = raw}) <- zip [(0 :: Int) ..] fields]+      <> [ "    ]",+           "",+           "parse" <> payloadType <> " :: Value -> Either Text " <> payloadType,+           "parse" <> payloadType <> " = mapLeftText . parseEither (withObject " <> tshow payloadType <> " go)",+           "  where",+           "    go objectValue = " <> payloadType <> queueFieldApplications fields,+           "",+           "mapLeftText :: Either String b -> Either Text b",+           "mapLeftText = either (Left . T.pack) Right"+         ]+      <> optionalFieldHelper+      <> unknownFieldHelper+  where+    payloadType = (.payloadName) workqueue+    fields = map resolveField ((.payload) workqueue)+    resolveField raw = case (.valueType) raw of+      LegacyQueueScalar {} -> ResolvedQueueField raw Nothing Nothing+      TypedQueueExpression expression ->+        case resolveTypeExpression graph owner ((.loc) raw) expression of+          Left failure -> error ("checked queue expression failed: " <> show failure)+          Right resolved ->+            ResolvedQueueField raw (Just resolved) (Just (mappedCodecPlanOrDie graph resolved))+      where+        owner = "workqueue '" <> (.name) workqueue <> "' payload field '" <> (.name) raw <> "'"+    plans = [plan | ResolvedQueueField {codecPlan = Just plan} <- fields]+    rootExpressions = [expression | ResolvedQueueField {expression = Just expression} <- fields]+    selectedKeys = Set.unions (map ((.dependencies) . (.consumerType)) plans)+    declarations = mapMaybe (`Map.lookup` (.declarations) graph) (Set.toAscList selectedKeys)+    structuralDeclarations = [(declaration, shape) | ResolvedStructural declaration shape <- declarations]+    mappedCodecExports (declaration, _) =+      [ "  , encode" <> (.name) declaration <> "Mapped",+        "  , decode" <> (.name) declaration <> "Mapped"+      ]+    hasStructural = not (null structuralDeclarations)+    allExpressions = rootExpressions <> concatMap (shapeTypeExpressions . snd) structuralDeclarations+    importsPlanReferences =+      Set.unions (map (consumerTypeReferences . (.consumerType)) plans)+        <> Set.fromList+          [ reference+          | (declaration, shape) <- structuralDeclarations,+            reference <-+              haskellTypeReference ((.haskell) declaration)+                : qualifiedValueReference ((.binding) declaration)+                : structuralShapeReferences ctx declaration shape+          ]+    importPlan =+      planImportsOrDie+        (genPrefix <> ".Queue")+        (Set.singleton payloadType)+        importsPlanReferences+    plannedModules = Set.map (.moduleName) importsPlanReferences+    opaqueInstanceImports =+      sort . nub $+        [ (.moduleName) ((.haskell) declaration) <> " ()"+        | ResolvedOpaque declaration <- declarations,+          Set.notMember ((.moduleName) ((.haskell) declaration)) plannedModules+        ]+    usesMap = any typeUsesMap allExpressions+    usesOptionalValue = any typeUsesOptional allExpressions+    usesNatural = any typeUsesNatural rootExpressions+    usesTime = any typeUsesTime rootExpressions+    usesParseJson = any (typeUsesParseJson graph) allExpressions+    usesToJson = any (typeUsesToJson graph) allExpressions+    usesValueConstructors = usesOptionalValue || any isEnumShape (map snd structuralDeclarations)+    usesWithText = any isTextShape (map snd structuralDeclarations)+    usesUnknownRejection = any rejectsUnknown (map snd structuralDeclarations)+    usesOptionalField = any hasOptionalField (map snd structuralDeclarations)+    usesKeyMap = usesUnknownRejection || usesOptionalField+    usesParser = hasStructural || any typeUsesParserAnnotation allExpressions+    usesLegacyDecoder = any isLegacy fields+    mappedQueueImports =+      ["import Control.Monad (unless)" | usesUnknownRejection]+        <> ["import Data.Aeson (" <> T.intercalate ", " aesonImports <> ")"]+        <> ["import Data.Aeson.Key qualified as Key" | usesKeyMap]+        <> ["import Data.Aeson.KeyMap qualified as KeyMap" | usesKeyMap]+        <> ["import Data.Aeson.Types (" <> T.intercalate ", " aesonTypesImports <> ")"]+        <> (if usesMap then ["import Data.Map.Strict (Map)", "import Data.Map.Strict qualified as Map"] else [])+        <> ["import Numeric.Natural (Natural)" | usesNatural]+        <> ["import Data.Time (UTCTime)" | usesTime]+        <> [ "import Data.Text (Text)",+             "import qualified Data.Text as T"+           ]+        <> ["import Keiro.Codec.Structural (bindingFromShape, bindingToShape)" | hasStructural]+        <> map ("import " <>) opaqueInstanceImports+        <> T.lines (renderPlannedImports importPlan)+    aesonImports =+      [if usesValueConstructors then "Value (..)" else "Value", "object"]+        <> ["parseJSON" | usesParseJson]+        <> ["toJSON" | usesToJson]+        <> ["withObject"]+        <> ["withText" | usesWithText]+        <> ["(.:)" | usesLegacyDecoder]+        <> ["(.=)"]+    aesonTypesImports =+      ["Parser" | usesParser]+        <> ["explicitParseField", "parseEither"]+    queueFieldType ResolvedQueueField {field = raw, expression = Nothing} = legacyQueueType raw+    queueFieldType ResolvedQueueField {expression = Just expression} =+      unHaskellTypeOccurrence $+        either+          (error . ("validated queue consumer type rendering failed: " <>) . show)+          id+          (renderConsumerType importPlan graph expression)+    strictQueueFieldType rendered+      | T.any (== ' ') rendered && not ("[" `T.isPrefixOf` rendered) = "!(" <> rendered <> ")"+      | otherwise = "!" <> rendered+    legacyQueueType raw = case (.valueType) raw of+      LegacyQueueScalar scalar -> case queueScalarName scalar of+        "bool" -> "Bool"+        "int" -> "Int"+        _ -> "Text"+      TypedQueueExpression {} -> error "typed queue field reached legacy type rendering"+    encodeQueueField ResolvedQueueField {field = raw, codecPlan = Nothing} = "payload." <> (.name) raw+    encodeQueueField ResolvedQueueField {field = raw, codecPlan = Just plan} =+      renderMappedEncode graph ConsumerValueBoundary plan ("payload." <> (.name) raw)+    decodeQueueField ResolvedQueueField {field = raw, codecPlan = Nothing} =+      "objectValue .: " <> tshow ((.wire) raw)+    decodeQueueField ResolvedQueueField {field = raw, codecPlan = Just plan} =+      "explicitParseField ("+        <> renderMappedParse graph ConsumerValueBoundary plan+        <> ") objectValue "+        <> tshow ((.wire) raw)+    queueFieldApplications [] = ""+    queueFieldApplications values = " <$> " <> T.intercalate " <*> " (map decodeQueueField values)+    groupKeyExport = case (.groupKey) workqueue of+      Nothing -> ""+      Just groupKey+        | (.via) groupKey == "raw" -> "  , groupKeyField, groupKeyFor"+        | otherwise -> "  , groupKeyField"+    groupKeyLines = case (.groupKey) workqueue of+      Nothing -> []+      Just groupKey ->+        [ "groupKeyField :: Text",+          "groupKeyField = " <> tshow ((.field) groupKey),+          ""+        ]+          <> if (.via) groupKey == "raw"+            then+              [ "groupKeyFor :: " <> payloadType <> " -> Text",+                "groupKeyFor payload = payload." <> (.field) groupKey,+                ""+              ]+            else+              [ "-- Opaque group-key derivation '" <> (.via) groupKey <> "' remains hand-owned.",+                "-- Captured fixture: " <> fromMaybe "<missing>" ((.fixture) groupKey),+                ""+              ]+    optionalFieldHelper =+      if usesOptionalField+        then+          [ "",+            "parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue",+            "parseOptionalField onMissing parseItem objectValue key =",+            "  case KeyMap.lookup key objectValue of",+            "    Nothing -> onMissing",+            "    Just _ -> explicitParseField parseItem objectValue key"+          ]+        else []+    unknownFieldHelper =+      if usesUnknownRejection+        then+          [ "",+            "rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()",+            "rejectUnknownFields label allowed objectValue =",+            "  unless (null extras) (fail (label <> \" contains unknown fields: \" <> show extras))",+            "  where",+            "    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))"+          ]+        else []+    isLegacy ResolvedQueueField {codecPlan = Nothing} = True+    isLegacy ResolvedQueueField {codecPlan = Just _} = False+    isEnumShape REnum {} = True+    isEnumShape _ = False+    isTextShape REnum {} = True+    isTextShape RUnion {} = True+    isTextShape _ = False+    rejectsUnknown (RRecord _ RejectUnknown _) = True+    rejectsUnknown (RUnion encoding _) = (.unknownFields) encoding == RejectUnknown+    rejectsUnknown _ = False+    hasOptionalField (RRecord _ _ shapeFields) = any ((== POptional) . (.presence)) shapeFields+    hasOptionalField _ = False++queueLead :: Int -> Text -> Text+queueLead 0 keyValue = "    [ " <> keyValue+queueLead _ keyValue = "    , " <> keyValue++typeUsesNatural :: ResolvedTypeExpr -> Bool+typeUsesNatural = foldTypeExpr (TypeExprAlgebra False False False False True False False id id id (const False))++typeUsesTime :: ResolvedTypeExpr -> Bool+typeUsesTime = foldTypeExpr (TypeExprAlgebra False False False False False True False id id id (const False))++typeUsesText :: ResolvedTypeExpr -> Bool+typeUsesText = foldTypeExpr (TypeExprAlgebra True False False False False False False id id (const True) (const False))++typeUsesJson :: ResolvedTypeExpr -> Bool+typeUsesJson = foldTypeExpr (TypeExprAlgebra False False False False False False True id id id (const False))++typeUsesParserAnnotation :: ResolvedTypeExpr -> Bool+typeUsesParserAnnotation = foldTypeExpr (TypeExprAlgebra False False False False False False False id (const True) (const True) (const False))++typeUsesParseJson :: TypeGraph -> ResolvedTypeExpr -> Bool+typeUsesParseJson graph =+  foldTypeExpr+    TypeExprAlgebra+      { onText = True,+        onInt = True,+        onInteger = True,+        onBool = True,+        onNatural = True,+        onTime = True,+        onJson = False,+        onOptional = id,+        onList = const True,+        onMap = const True,+        onRef = \key -> case Map.lookup key ((.declarations) graph) of+          Just ResolvedOpaque {} -> True+          _ -> False+      }++typeUsesToJson :: TypeGraph -> ResolvedTypeExpr -> Bool+typeUsesToJson = typeUsesParseJson++workqueueUsesRecordDot :: WorkqueueNode -> Bool+workqueueUsesRecordDot workqueue =+  not (null ((.payload) workqueue))+    || maybe False ((== "raw") . (.via)) ((.groupKey) workqueue)++-- | Emit the versioned PGMQ envelope adapter.  The payload record remains+-- symbol-free and dependency-light in Queue.hs; this runtime-facing module is+-- the opt-in assembly point applications import into their Job values.+emitQueueCodec :: Text -> WorkqueueNode -> Text+emitQueueCodec genPrefix w =+  nl+    [ generatedBanner,+      "-- | Versioned job payload envelope: @{\\\"v\\\",\\\"t\\\",\\\"data\\\"}@.",+      "--",+      "-- Deploy workers before producers when raising its schema version. Do not",+      "-- adopt this codec on a non-empty bare-payload queue without draining it",+      "-- (or supplying a transitional codec), or in-flight messages will",+      "-- dead-letter. This is telemetry-neutral:",+      "-- docs/adr/0001-keiro-pgmq-job-processing-telemetry-contract.md owns",+      "-- spans and acknowledgement vocabulary.",+      "module " <> genPrefix <> ".QueueCodec (" <> stem <> "PayloadCodec, " <> stem <> "JobCodec) where",+      "",+      "import Data.List.NonEmpty (NonEmpty (..))",+      "import Keiro.Codec (Codec (..), EventType (..))",+      "import Keiro.PGMQ.Codec (JobCodec, keiroJobCodec)",+      "import " <> genPrefix <> ".Queue (" <> payloadTy <> ", encode" <> payloadTy <> ", parse" <> payloadTy <> ")",+      "",+      stem <> "PayloadCodec :: Codec " <> payloadTy,+      stem <> "PayloadCodec =",+      "  Codec",+      "    { eventTypes = EventType " <> tshow payloadTy <> " :| []",+      "    , eventType = \\_ -> EventType " <> tshow payloadTy,+      "    , schemaVersion = 1",+      "    , encode = encode" <> payloadTy,+      "    , decode = \\_ -> parse" <> payloadTy,+      "    , upcasters = []",+      "    }",+      "",+      stem <> "JobCodec :: JobCodec " <> payloadTy,+      stem <> "JobCodec = keiroJobCodec " <> stem <> "PayloadCodec"+    ]+  where+    payloadTy = (.payloadName) w+    stem = lowerFirst (T.concat (map pascal (T.splitOn "_" ((.name) w))))++-- | Emit the pgmq retry policy + JobOutcome disposition compiled against the+-- LIVE @Keiro.PGMQ.Job@ runtime (RetryPolicy / JobOutcome / RetryDelay). This pins+-- the dangerous inversions over the runtime types: storeFailure ⇒ Retry (transient)+-- and decodeFailure ⇒ Dead (poison).+emitQueuePolicy :: Text -> WorkqueueNode -> Text+emitQueuePolicy genPrefix w =+  nl $+    [ generatedBanner,+      "module " <> genPrefix <> ".QueuePolicy",+      "  ( " <> outcomeType <> " (..)",+      "  , retryPolicy, jobOutcomeFor",+      "  , jobOrdering, jobTuningFor, queueProvision",+      "  ) where",+      "",+      "import Keiro.PGMQ.Job (" <> T.intercalate ", " queuePolicyImports <> ")",+      "",+      "jobOrdering :: JobOrdering",+      "jobOrdering = " <> orderingCtor,+      "",+      "-- Deployment owns visibility timeout, batch size, and polling; the spec owns ordering.",+      "jobTuningFor :: JobTuning -> JobTuning",+      "jobTuningFor = withOrdering jobOrdering",+      "",+      "-- Pass this to ensureJobQueueWith at worker startup. FIFO adds the required GIN index; the DLQ remains standard.",+      "queueProvision :: QueueProvision",+      "queueProvision = " <> provisionExpr,+      "",+      "retryPolicy :: RetryPolicy",+      "retryPolicy =",+      "  RetryPolicy",+      "    { maxRetries = " <> tshow' ((.maxRetries) w),+      "    , defaultRetryDelay = RetryDelay " <> windowText ((.delay) w),+      "    , useDeadLetter = " <> (if (.dlqOn) w then "True" else "False"),+      "    }",+      "",+      "-- The consumer JobOutcome disposition over the spec's named domain outcomes,",+      "-- lowered to the live Keiro.PGMQ.Job.JobOutcome.",+      "data " <> outcomeType,+      "  = " <> T.intercalate "\n  | " (map (pascal . (.outcome)) ((.disposition) w)),+      "  deriving stock (Eq, Show)",+      "",+      "jobOutcomeFor :: " <> outcomeType <> " -> JobOutcome",+      "jobOutcomeFor o = case o of"+    ]+      ++ ["  " <> pascal ((.outcome) r) <> " -> " <> outcome ((.action) r) | r <- (.disposition) w]+  where+    outcomeType = T.concat (map pascal (T.splitOn "_" ((.name) w))) <> "Outcome"+    queuePolicyImports =+      [ "JobOrdering (..)",+        "JobOutcome (..)",+        "JobTuning",+        "QueueProvision",+        "RetryDelay (..)",+        "RetryPolicy (..)"+      ]+        <> ( case (.provision) w of+               WqStandard -> ["standardProvision"]+               WqUnlogged -> ["unloggedProvision"]+               WqPartitioned {} -> ["PartitionSpec (..)", "partitionedProvision"]+           )+        <> ["withFifoIndexProvision" | (.ordering) w /= WqUnordered]+        <> ["withOrdering"]+    orderingCtor = case (.ordering) w of+      WqUnordered -> "Unordered"+      WqFifoThroughput -> "FifoThroughput"+      WqFifoRoundRobin -> "FifoRoundRobin"+    provisionExpr = fifoWrap baseProvision+    fifoWrap expression = case (.ordering) w of+      WqUnordered -> expression+      _ -> "withFifoIndexProvision (" <> expression <> ")"+    baseProvision = case (.provision) w of+      WqStandard -> "standardProvision"+      WqUnlogged -> "unloggedProvision"+      WqPartitioned interval retention ->+        "partitionedProvision (PartitionSpec { partitionInterval = "+          <> tshow interval+          <> ", retentionInterval = "+          <> tshow retention+          <> " })"+    outcome IAckOk = "Done"+    outcome (IRetry win) = "Retry (RetryDelay " <> windowText win <> ")"+    outcome (IDeadLetter mr) = "Dead " <> tshow (fromMaybe "dead-lettered" mr)++--------------------------------------------------------------------------------+-- First-class read models (EP-107)+--------------------------------------------------------------------------------++-- | Emit an acyclic three-module read-model vertical. @ReadModelTable@ owns the+-- qualified-table constant shared by the hand-owned query and the generated+-- runtime record; @ReadModel@ re-exports it as part of the public surface.+scaffoldReadModel :: Context -> ReadModelNode -> [ScaffoldModule]+scaffoldReadModel ctx readModel =+  [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),+    generated "ReadModel" (emitReadModelGen ctx readModelModule tableModule readModelHolePrefix stem readModel),+    ScaffoldModule+      { path = modulePathFor readModelHolePrefix "ReadModelHoles",+        text = emitReadModelHoles tableModule readModelHolePrefix stem readModel,+        kind = HoleStub,+        origin = readModelOrigin+      }+  ]+  where+    nodeSegment = pascal ((.name) readModel)+    stem = readModelStem readModel+    readModelModule = genPrefixFor ctx nodeSegment+    tableModule = readModelModule <> ".ReadModelTable"+    readModelHolePrefix = holePrefixFor ctx nodeSegment+    readModelOrigin = nodeOrigin "readmodel" ((.name) readModel) ((.loc) readModel)+    generated leaf body =+      ScaffoldModule+        { path = modulePathFor readModelModule leaf,+          text = body,+          kind = Generated,+          origin = readModelOrigin+        }++-- | Service-aware read-model generation adds a generated query contract only+-- for the candidate typed query pair. Legacy read models stay on+-- 'scaffoldReadModel' so their generated and create-once bytes remain exact.+scaffoldReadModelForService :: Context -> CheckedService -> ReadModelNode -> [ScaffoldModule]+scaffoldReadModelForService ctx service readModel = case (.queryTypes) readModel of+  Nothing ->+    [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),+      generated "ReadModel" (emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix (ownerDerivedCursor service readModel) Nothing stem readModel),+      ScaffoldModule+        { path = modulePathFor readModelHolePrefix "ReadModelHoles",+          text = emitReadModelHoles tableModule readModelHolePrefix stem readModel,+          kind = HoleStub,+          origin = readModelOrigin+        }+    ]+  Just queryPair ->+    [ generated "ReadModelTable" (emitReadModelTable tableModule stem readModel),+      generated "QueryContract" (emitReadModelQueryContract queryContractModule graph stem readModel queryPair),+      generated "ReadModel" (emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix (ownerDerivedCursor service readModel) (Just queryContractModule) stem readModel),+      ScaffoldModule+        { path = modulePathFor readModelHolePrefix "ReadModelHoles",+          text = emitTypedReadModelHoles tableModule queryContractModule readModelHolePrefix stem readModel,+          kind = HoleStub,+          origin = readModelOrigin+        }+    ]+  where+    nodeSegment = pascal ((.name) readModel)+    stem = readModelStem readModel+    readModelModule = genPrefixFor ctx nodeSegment+    tableModule = readModelModule <> ".ReadModelTable"+    queryContractModule = readModelModule <> ".QueryContract"+    readModelHolePrefix = holePrefixFor ctx nodeSegment+    readModelOrigin = nodeOrigin "readmodel" ((.name) readModel) ((.loc) readModel)+    graph = case checkedTypeGraph service of+      Left errors -> error ("checked read-model type graph failed: " <> show errors)+      Right value -> value+    generated leaf body =+      ScaffoldModule+        { path = modulePathFor readModelModule leaf,+          text = body,+          kind = Generated,+          origin = readModelOrigin+        }++ownerDerivedCursor :: CheckedService -> ReadModelNode -> Maybe Text+ownerDerivedCursor service readModel = do+  ownerName <- case [ (.projectionOwner) supply+                    | supply <- (.resolvedProjectionSupplies) (checkedProjectionSupplies service),+                      (.queryModel) supply == (.name) readModel+                    ] of+    [name] -> Just name+    _ -> Nothing+  owner <- case [candidate | NProjectionOwner candidate <- (.nodes) (checkedSpec service), (.name) candidate == ownerName] of+    [candidate] -> Just candidate+    _ -> Nothing+  case (.delivery) owner of+    DeliveryInline -> Nothing+    DeliverySubscription -> (.subscription) owner++-- | Resolve a catalog-bound read model's physical binding to its backing+-- target's coordinates, by name. An unbound or unresolvable model is returned+-- unchanged; validation rejects those forms before scaffolding.+resolveCatalogReadModel :: Spec -> ReadModelNode -> ReadModelNode+resolveCatalogReadModel spec readModel = case (.group) readModel of+  Nothing -> readModel+  Just _ ->+    let backingName = case (.backingTarget) readModel of+          Just name -> Just name+          Nothing -> case (.observedTargets) readModel of+            [single] -> Just single+            _ -> Nothing+     in case [target | NProjectionTarget target <- (.nodes) spec, Just ((.name) target) == backingName] of+          target : _ ->+            ReadModelNode+              { name = readModel.name,+                table = target.table,+                schema = target.schema,+                columns = readModel.columns,+                version = readModel.version,+                shape = readModel.shape,+                freshness = readModel.freshness,+                supply = readModel.supply,+                group = readModel.group,+                observedTargets = readModel.observedTargets,+                backingTarget = readModel.backingTarget,+                queryTypes = readModel.queryTypes,+                loc = readModel.loc+              }+          [] -> readModel++-- | Generate one service-level catalog facade and one create-once module that+-- owns application handler/decoder bodies. The checked DSL graph owns every+-- identity and relationship; the hole supplies only executable projection+-- sets, never a second inventory.+scaffoldProjectionCatalog :: Context -> Spec -> [ScaffoldModule]+scaffoldProjectionCatalog ctx spec =+  scaffoldProjectionCatalogWith+    (projectionAggregateSourceFingerprint spec)+    ctx+    spec+    (analyzeProjectionSupplies spec)++scaffoldProjectionCatalogForService :: Context -> CheckedService -> [ScaffoldModule]+scaffoldProjectionCatalogForService ctx service =+  scaffoldProjectionCatalogWith+    (projectionAggregateSourceFingerprintForService service)+    ctx+    (checkedSpec service)+    (checkedProjectionSupplies service)++scaffoldProjectionCatalogWith :: (Name -> Text) -> Context -> Spec -> ProjectionSupplyAnalysis -> [ScaffoldModule]+scaffoldProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis+  | null catalogNodes = []+  | otherwise =+      [ ScaffoldModule+          { path = modulePathFor (contextGeneratedPrefix ctx) "ProjectionCatalog",+            text = emitProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis,+            kind = Generated,+            origin = "projection-catalog " <> (.name) ctx+          },+        ScaffoldModule+          { path = modulePathFor (holePrefixFor ctx "ProjectionCatalog") "ProjectionCatalogHoles",+            text = emitProjectionCatalogHoles ctx spec owners revisions externalReads,+            kind = HoleStub,+            origin = "projection-catalog " <> (.name) ctx+          }+      ]+  where+    catalogNodes = [() | node <- (.nodes) spec, isCatalogNode node]+    owners = sortOn (.order) [owner | NProjectionOwner owner <- (.nodes) spec]+    revisions = sortOn (.name) [revision | NProjectionRevision revision <- (.nodes) spec]+    externalReads = sortOn (\externalRead -> ((.name) externalRead, (.version) externalRead)) [externalRead | NExternalRead externalRead <- (.nodes) spec]+    isCatalogNode NProjectionTarget {} = True+    isCatalogNode NRebuildGroup {} = True+    isCatalogNode NProjectionRevision {} = True+    isCatalogNode NExternalRead {} = True+    isCatalogNode NProjectionOwner {} = True+    isCatalogNode _ = False++emitProjectionCatalogWith :: (Name -> Text) -> Context -> Spec -> ProjectionSupplyAnalysis -> Text+emitProjectionCatalogWith aggregateFingerprint ctx spec supplyAnalysis =+  nl $+    [ generatedBanner,+      "{-# LANGUAGE OverloadedStrings #-}",+      "module " <> moduleName,+      "  ( projectionCatalog",+      "  , validatedProjectionCatalog",+      "  , projectionCatalogInventory",+      "  , projectionCatalogRegistrations",+      "  , projectionCatalogAsyncRegistrations",+      "  , projectionCatalogQuerySupplies",+      "  , registerProjectionCatalog"+    ]+      ++ map (("  , " <>) . ownerSetName) owners+      ++ map (("  , " <>) . ownerInlineViewName) inlineOwners+      ++ map (("  , " <>) . aggregateInlineViewName . fst) aggregateInlineOwners+      ++ concatMap groupExports groups+      ++ [ "  ) where",+           "",+           "import Data.List.NonEmpty (NonEmpty (..))",+           "import Effectful (Eff, IOE, (:>))"+         ]+      ++ ["import Data.Map.Strict qualified as Map" | not (null revisions)]+      ++ concatMap aggregateImports aggregateSources+      ++ projectionImports+      ++ [ "import Keiro.Projection.Catalog qualified as Catalog",+           "import Keiro.ReadModel.Rebuild qualified as Rebuild",+           "import Kiroku.Store.Effect (Store)"+         ]+      ++ ["import Kiroku.Store.Types qualified as Kiroku" | any sourceUsesCategoryName sources]+      ++ ["import Kiroku.Store.Subscription.Types qualified as KirokuSubscription" | not (null asyncOwners)]+      ++ ["import " <> holesModule <> " qualified as Holes"]+      ++ map readModelImport readModels+      ++ [ "",+           "must :: Show error => Either error value -> value",+           "must = either (error . show) id"+         ]+      ++ concatMap ownerDefinition owners+      ++ concatMap aggregateInlineDefinition aggregateInlineOwners+      ++ [ "",+           "projectionCatalog :: Catalog.ProjectionCatalog",+           "projectionCatalog =",+           "  Catalog.ProjectionCatalog",+           "    " <> renderList sourceExpr sources,+           "    " <> renderList targetExpr targets,+           "    " <> renderList groupExpr groups,+           "    " <> renderList revisionExpr revisions,+           "    " <> renderList externalReadExpr externalReads,+           "    " <> renderList subscriptionExpr asyncOwners,+           "    " <> renderList dedupExpr asyncOwners,+           "    " <> renderList queryExpr boundReadModels,+           "    " <> renderList (("Catalog.SomeProjectionSet " <>) . ownerSetName) owners,+           "",+           "validatedProjectionCatalog :: Catalog.ValidatedProjectionCatalog",+           "validatedProjectionCatalog = case Catalog.validateProjectionCatalog projectionCatalog of",+           "  Catalog.Success catalog -> catalog",+           "  Catalog.Failure diagnostics -> error (\"keiro-dsl generated an invalid projection catalog: \" <> show diagnostics)",+           "",+           "projectionCatalogInventory :: Catalog.CatalogInventory",+           "projectionCatalogInventory = Catalog.catalogInventory validatedProjectionCatalog",+           "",+           "projectionCatalogRegistrations :: [Catalog.CatalogRegistration]",+           "projectionCatalogRegistrations = Catalog.catalogRegistrations validatedProjectionCatalog",+           "",+           "projectionCatalogAsyncRegistrations :: [Catalog.AsyncProjectionRegistration]",+           "projectionCatalogAsyncRegistrations = Catalog.asyncProjectionRegistrations validatedProjectionCatalog",+           "",+           "projectionCatalogQuerySupplies :: [Catalog.ResolvedQuerySupply]",+           "projectionCatalogQuerySupplies = Catalog.resolvedQuerySupplies validatedProjectionCatalog",+           "",+           "registerProjectionCatalog :: (Store :> es) => Eff es (Either Rebuild.CatalogRegistrationError [Rebuild.GroupRebuildMetadata])",+           "registerProjectionCatalog = Rebuild.registerProjectionCatalog validatedProjectionCatalog"+         ]+      ++ concatMap groupDefinitions groups+  where+    moduleName = contextGeneratedPrefix ctx <> ".ProjectionCatalog"+    holesModule = holePrefixFor ctx "ProjectionCatalog" <> ".ProjectionCatalogHoles"+    targets = [target | NProjectionTarget target <- (.nodes) spec]+    groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]+    revisions = sortOn (.name) [revision | NProjectionRevision revision <- (.nodes) spec]+    externalReads = sortOn (\externalRead -> ((.name) externalRead, (.version) externalRead)) [externalRead | NExternalRead externalRead <- (.nodes) spec]+    -- The catalog's list order is the declared total handler order. Keeping the+    -- sort here (rather than in the runtime) makes generated inventory and replay+    -- behavior agree even when declarations are arranged for readability.+    owners = sortOn (.order) [owner | NProjectionOwner owner <- (.nodes) spec]+    inlineOwners = [owner | owner <- owners, (.delivery) owner == DeliveryInline]+    sources = nub (concatMap (.sources) owners)+    aggregateSources = nub [aggregateName | CatalogAggregate aggregateName <- sources]+    replayableAggregateSources =+      nub+        [ aggregateName+        | owner <- owners,+          (.replay) owner == ProjectionReplayExplicit,+          CatalogAggregate aggregateName <- (.sources) owner+        ]+    asyncOwners = [owner | owner <- owners, (.delivery) owner == DeliverySubscription]+    projectionImports = case (null asyncOwners, null inlineOwners) of+      (False, False) -> ["import Keiro.Projection (AsyncProjection (..), InlineProjection (..))"]+      (False, True) -> ["import Keiro.Projection (AsyncProjection (..))"]+      (True, False) -> ["import Keiro.Projection (InlineProjection (..))"]+      (True, True) -> []+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]+    supplies = (.resolvedProjectionSupplies) supplyAnalysis+    boundReadModels =+      [ readModel+      | supply <- supplies,+        readModel <- readModels,+        (.name) readModel == (.queryModel) supply+      ]+    readModelAlias readModel = "RM" <> pascal ((.name) readModel)+    readModelImport readModel = "import " <> genPrefixFor ctx (pascal ((.name) readModel)) <> ".ReadModel qualified as " <> readModelAlias readModel+    aggregateImports aggregateName =+      [ "import " <> genPrefixFor ctx aggregateName <> ".Codec qualified as " <> aggregateCodecAlias aggregateName+      | aggregateName `elem` replayableAggregateSources+      ]+        <> ["import " <> genPrefixFor ctx aggregateName <> ".Domain qualified as " <> aggregateDomainAlias aggregateName]+    aggregateCodecAlias aggregateName = pascal aggregateName <> "Codec"+    aggregateDomainAlias aggregateName = pascal aggregateName <> "Domain"+    sourceExpr source =+      "Catalog.SourceDeclaration "+        <> smart "mkSourceId" (catalogSourceId source)+        <> " "+        <> sourceScope source+        <> " "+        <> tshow (sourceFingerprint source)+        <> " "+        <> claim ("source " <> catalogSourceId source)+    sourceScope CatalogAll = "Catalog.AllStreams"+    sourceScope (CatalogCategory categoryName) = "(Catalog.CategorySource (Kiroku.CategoryName " <> tshow categoryName <> "))"+    sourceScope (CatalogAggregate aggregateName) = "(Catalog.CategorySource (Kiroku.CategoryName " <> tshow (lowerFirst aggregateName) <> "))"+    sourceFingerprint CatalogAll = "all-streams/generated-codec/v1"+    sourceFingerprint (CatalogCategory categoryName) = "category:" <> categoryName <> "/application-decoder/v1"+    sourceFingerprint (CatalogAggregate aggregateName) = aggregateFingerprint aggregateName+    sourceUsesCategoryName CatalogAll = False+    sourceUsesCategoryName CatalogCategory {} = True+    sourceUsesCategoryName CatalogAggregate {} = True+    targetExpr target =+      "Catalog.TargetDeclaration "+        <> smart "mkTargetId" ((.name) target)+        <> " (Catalog.QualifiedTable "+        <> tshow ((.schema) target)+        <> " "+        <> tshow ((.table) target)+        <> ") "+        <> (case (.reset) target of TargetClear -> "Catalog.ClearBeforeReplay"; TargetPreserve -> "Catalog.PreserveAndReconcile")+        <> " "+        <> renderList (smart "mkTargetId") ((.dependsOn) target)+        <> " "+        <> claim ("target " <> (.name) target)+    groupExpr groupNode =+      "Catalog.RebuildGroupDeclaration "+        <> smart "mkRebuildGroupId" ((.name) groupNode)+        <> " "+        <> renderList (smart "mkTargetId") ((.order) groupNode)+        <> " [] "+        <> claim ("rebuild-group " <> (.name) groupNode)+    revisionExpr revision =+      "Catalog.ProjectionRevision "+        <> smart "mkProjectionRevisionId" ((.name) revision)+        <> " "+        <> smart "mkRebuildGroupId" ((.group) revision)+        <> " (Map.fromList "+        <> renderList (revisionTargetExpr revision) ((.targets) revision)+        <> ") "+        <> renderList (revisionLiveHandlerExpr revision) (revisionOwners revision)+        <> " "+        <> "[Catalog.RevisionReplayAdapter "+        <> tshow ((.name) revision <> "/replay")+        <> " 1 "+        <> revisionRequiredTargets revision+        <> " Holes."+        <> revisionReplayName revision+        <> "] "+        <> "[Catalog.RevisionVerification "+        <> tshow ((.name) revision <> "/verification")+        <> " 1 "+        <> revisionRequiredTargets revision+        <> " Holes."+        <> revisionVerificationName revision+        <> "] [] "+        <> claim ("projection-revision " <> (.name) revision)+    revisionOwners revision = [owner | owner <- owners, (.group) owner == (.group) revision]+    revisionLiveHandlerExpr revision owner =+      "Catalog.RevisionLiveHandler "+        <> tshow ((.name) revision <> "/" <> (.name) owner <> "/live")+        <> " 1 "+        <> revisionLiveDeliveryExpr owner+        <> " "+        <> renderList (smart "mkTargetId") ((.targets) owner)+        <> " Holes."+        <> revisionOwnerLiveName revision owner+    revisionLiveDeliveryExpr owner = case (.delivery) owner of+      DeliveryInline ->+        "(Catalog.RevisionInlineDelivery "+          <> smart "mkProjectionId" ((.name) owner)+          <> " "+          <> tshow ((.name) owner)+          <> ")"+      DeliverySubscription ->+        "(Catalog.RevisionSubscriptionDelivery "+          <> smart "mkProjectionId" ((.name) owner)+          <> " "+          <> smart "mkSubscriptionId" (fromMaybe "" ((.subscription) owner))+          <> " "+          <> smart "mkDedupKeyId" (fromMaybe "" ((.dedup) owner))+          <> ")"+    revisionTargetExpr revision target =+      "("+        <> smart "mkTargetId" ((.target) target)+        <> ", Catalog.TargetProvisioner "+        <> tshow ((.provisioner) target)+        <> " "+        <> T.pack (show ((.provisionerVersion) target))+        <> " (Catalog.TargetSchemaVersion "+        <> tshow ((.schemaVersion) target)+        <> ") "+        <> tshow ((.expectedShape) target)+        <> " Holes."+        <> revisionProvisionName revision target+        <> " "+        <> tshow ((.validator) target)+        <> " "+        <> T.pack (show ((.validatorVersion) target))+        <> " (Just Holes."+        <> revisionValidateName revision target+        <> ") "+        <> renderList promotionObjectExpr ((.promotionObjects) target)+        <> ")"+    externalReadExpr externalRead =+      "Catalog.AllRowsExternalRead "+        <> smart "mkExternalReadContractId" ((.name) externalRead)+        <> " (Catalog.ExternalReadContractVersion "+        <> T.pack (show ((.version) externalRead))+        <> ") "+        <> smart "mkQueryModelId" ((.queryModel) externalRead)+        <> " (Catalog.QualifiedSqlType "+        <> tshow ((.resultSchema) externalRead)+        <> " "+        <> tshow ((.resultType) externalRead)+        <> ") "+        <> tshow (externalReadShape externalRead)+        <> " "+        <> nonEmptyList (smart "mkProjectionRevisionId") ((.compatibleRevisions) externalRead)+        <> " "+        <> T.pack (show ((.surfaceGeneration) externalRead))+        <> " "+        <> claim ("external-read " <> (.name) externalRead <> " v" <> T.pack (show ((.version) externalRead)))+    externalReadShape externalRead = case [(.shape) readModel | readModel <- readModels, (.name) readModel == (.queryModel) externalRead] of+      shape : _ -> shape+      [] -> "keiro-dsl invariant: validated external read query is missing"+    promotionObjectExpr promotionObject =+      "Catalog.PromotionObjectName "+        <> ( case (.kind) promotionObject of+               PromotionIndexNode -> "Catalog.PromotionIndex"+               PromotionConstraintNode -> "Catalog.PromotionConstraint"+               PromotionOwnedSequenceNode -> "Catalog.PromotionOwnedSequence"+           )+        <> " "+        <> tshow ((.generationName) promotionObject)+        <> " "+        <> tshow ((.canonicalName) promotionObject)+    revisionRequiredTargets revision = renderList (smart "mkTargetId") (map (.target) ((.targets) revision))+    subscriptionExpr owner =+      "Catalog.SubscriptionDeclaration "+        <> smart "mkSubscriptionId" (fromMaybe "" ((.subscription) owner))+        <> " "+        <> tshow (fromMaybe "" ((.subscription) owner))+        <> " "+        <> smart "mkSourceId" (catalogSourceId (ownerPrimarySource owner))+        <> " "+        <> checkpointOnMissingExpr owner+        <> " "+        <> claim ("projection-owner " <> (.name) owner <> " subscription")+    dedupExpr owner =+      "Catalog.DedupKeyDeclaration "+        <> smart "mkDedupKeyId" (fromMaybe "" ((.dedup) owner))+        <> " "+        <> tshow (fromMaybe "" ((.dedup) owner))+        <> " "+        <> claim ("projection-owner " <> (.name) owner <> " dedup")+    queryExpr readModel =+      "Catalog.SomeQueryModelBinding (Catalog.QueryModelBinding "+        <> smart "mkQueryModelId" ((.name) readModel)+        <> " "+        <> readModelAlias readModel+        <> "."+        <> readModelStem readModel+        <> "ReadModel "+        <> smart "mkRebuildGroupId" (fromMaybe "" ((.group) readModel))+        <> " "+        <> renderList (smart "mkTargetId") (sort ((.observedTargets) readModel))+        <> " "+        <> claim ("readmodel " <> (.name) readModel)+        <> ")"+    ownerSetName owner = lowerFirst (pascal ((.name) owner)) <> "ProjectionSet"+    ownerInlineViewName owner = lowerFirst (pascal ((.name) owner)) <> "InlineProjections"+    aggregateInlineViewName aggregateName = lowerFirst (pascal aggregateName) <> "InlineProjections"+    aggregateInlineOwners =+      [ (aggregateName, matchingOwners)+      | aggregateName <- sort aggregateSources,+        let matchingOwners =+              [ owner+              | owner <- inlineOwners,+                ownerPrimarySource owner == CatalogAggregate aggregateName+              ],+        not (null matchingOwners)+      ]+    ownerEventType owner = case ownerPrimarySource owner of+      CatalogAggregate aggregateName -> aggregateDomainAlias aggregateName <> "." <> pascal aggregateName <> "Event"+      _ -> "Holes." <> pascal ((.name) owner) <> "Event"+    ownerDefinition owner =+      [ "",+        ownerSetName owner <> " :: Catalog.ProjectionSet " <> ownerEventType owner,+        ownerSetName owner <> " =",+        "  Catalog.ProjectionSet",+        "    " <> smart "mkSourceId" (catalogSourceId (ownerPrimarySource owner)),+        "    (Catalog.ProjectionDefinition",+        "      " <> smart "mkProjectionId" ((.name) owner),+        "      " <> smart "mkRebuildGroupId" ((.group) owner),+        "      " <> nonEmptyList (smart "mkTargetId") ((.targets) owner),+        "      " <> replayPolicyExpr owner,+        "      (" <> handlerExpr owner <> " :| [])",+        "      " <> claim ("projection-owner " <> (.name) owner),+        "      :| [])",+        "    " <> claim ("projection-owner " <> (.name) owner <> " source")+      ]+        ++ if (.delivery) owner == DeliveryInline+          then+            [ "",+              ownerInlineViewName owner <> " :: [InlineProjection " <> ownerEventType owner <> "]",+              ownerInlineViewName owner <> " = Catalog.typedInlineProjections validatedProjectionCatalog " <> ownerSetName owner+            ]+          else []+    aggregateInlineDefinition (aggregateName, sourceOwners) =+      [ "",+        aggregateInlineViewName aggregateName <> " :: [InlineProjection " <> aggregateDomainAlias aggregateName <> "." <> pascal aggregateName <> "Event]",+        aggregateInlineViewName aggregateName+          <> " = concat ["+          <> T.intercalate ", " (map ownerInlineViewName sourceOwners)+          <> "]"+      ]+    replayPolicyExpr owner = case (.replay) owner of+      ProjectionLiveOnly reason -> "(Catalog.LiveOnly (Catalog.LiveOnlyReason " <> tshow reason <> "))"+      ProjectionReplayExplicit -> case ownerPrimarySource owner of+        CatalogAggregate aggregateName ->+          "(Catalog.Replayable (Catalog.replayAdapterFromCodec "+            <> aggregateCodecAlias aggregateName+            <> "."+            <> lowerFirst aggregateName+            <> "Codec Holes."+            <> ownerReplayApplyName owner+            <> "))"+        _ ->+          "(Catalog.Replayable (Catalog.ReplayAdapter Holes."+            <> ownerReplayDecodeName owner+            <> " Holes."+            <> ownerReplayApplyName owner+            <> "))"+    handlerExpr owner = case (.delivery) owner of+      DeliveryInline ->+        "Catalog.InlineHandler (InlineProjection "+          <> tshow ((.name) owner)+          <> " Holes."+          <> ownerLiveApplyName owner+          <> ") "+          <> claim ("projection-owner " <> (.name) owner <> " inline-handler")+      DeliverySubscription ->+        "Catalog.AsyncHandler (AsyncProjection "+          <> tshow (fromMaybe "" ((.dedup) owner))+          <> " "+          <> tshow (ownerQueryRegistry owner)+          <> " "+          <> tshow (fromMaybe "" ((.subscription) owner))+          <> " Holes."+          <> ownerLiveApplyName owner+          <> " Holes."+          <> ownerIdempotencyName owner+          <> ") "+          <> smart "mkSubscriptionId" (fromMaybe "" ((.subscription) owner))+          <> " "+          <> smart "mkDedupKeyId" (fromMaybe "" ((.dedup) owner))+          <> " "+          <> claim ("projection-owner " <> (.name) owner <> " async-handler")+    ownerQueryRegistry owner = case matchingReadModels owner of+      readModel : _ -> registryNameFor ((.name) ctx) readModel+      [] -> ""+    matchingReadModels owner =+      [ readModel+      | supply <- supplies,+        (.projectionOwner) supply == (.name) owner,+        readModel <- boundReadModels,+        (.name) readModel == (.queryModel) supply+      ]+    ownerLiveApplyName owner = "apply" <> pascal ((.name) owner) <> "Live"+    ownerReplayApplyName owner = "apply" <> pascal ((.name) owner) <> "Replay"+    ownerReplayDecodeName owner = "decode" <> pascal ((.name) owner) <> "Replay"+    ownerIdempotencyName owner = lowerFirst (pascal ((.name) owner)) <> "IdempotencyKey"+    revisionProvisionName revision target = "provision" <> pascal ((.name) revision) <> pascal ((.target) target)+    revisionValidateName revision target = "validate" <> pascal ((.name) revision) <> pascal ((.target) target)+    revisionOwnerLiveName revision owner = "apply" <> pascal ((.name) revision) <> pascal ((.name) owner) <> "Live"+    revisionReplayName revision = "apply" <> pascal ((.name) revision) <> "Replay"+    revisionVerificationName revision = "verify" <> pascal ((.name) revision)+    groupIdName groupNode = lowerFirst (pascal ((.name) groupNode)) <> "RebuildGroupId"+    groupStartName groupNode = "start" <> pascal ((.name) groupNode) <> "Rebuild"+    groupExports groupNode = ["  , " <> groupIdName groupNode, "  , " <> groupStartName groupNode]+    groupDefinitions groupNode =+      [ "",+        groupIdName groupNode <> " :: Catalog.RebuildGroupId",+        groupIdName groupNode <> " = " <> smart "mkRebuildGroupId" ((.name) groupNode),+        "",+        groupStartName groupNode <> " :: (IOE :> es, Store :> es) => Rebuild.RebuildOptions -> Eff es (Either Rebuild.CatalogRebuildError Rebuild.RebuildRunReport)",+        groupStartName groupNode <> " = Rebuild.startCatalogRebuild validatedProjectionCatalog " <> groupIdName groupNode+      ]+    smart constructor value = "(must (Catalog." <> constructor <> " " <> tshow value <> "))"+    claim value = smart "mkClaimSite" value+    renderList render values = "[" <> T.intercalate ", " (map render values) <> "]"+    nonEmptyList _ [] = "error \"keiro-dsl invariant: validated projection owner has no targets\""+    nonEmptyList render (value : values) = "(" <> render value <> " :| " <> renderList render values <> ")"+    ownerPrimarySource owner = case (.sources) owner of+      source : _ -> source+      [] -> CatalogAll+    checkpointOnMissingExpr owner = case (.checkpointOnMissing) owner of+      [CheckpointFromBeginning] -> "KirokuSubscription.FromBeginning"+      [CheckpointFromCurrentHead] -> "KirokuSubscription.FromCurrentHead"+      [CheckpointFail] -> "KirokuSubscription.FailIfMissing"+      _ -> "error \"keiro-dsl invariant: validated subscription owner must declare exactly one checkpoint-on-missing policy\""++emitProjectionCatalogHoles :: Context -> Spec -> [ProjectionOwnerNode] -> [ProjectionRevisionNode] -> [ExternalReadNode] -> Text+emitProjectionCatalogHoles ctx spec owners revisions externalReads =+  nl $+    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",+      "module " <> moduleName,+      "  ( " <> T.intercalate "\n  , " exports,+      "  ) where",+      ""+    ]+      ++ ["import " <> genPrefixFor ctx aggregateName <> ".Domain (" <> pascal aggregateName <> "Event)" | aggregateName <- aggregateSources]+      ++ ["import Data.Text (Text)" | not (null revisions)]+      ++ ["import Data.List.NonEmpty (NonEmpty (..))" | not (null externalReads)]+      ++ [ "import Hasql.Transaction qualified as Tx",+           "import Keiro.Projection.Catalog qualified as Catalog",+           "import Kiroku.Store.Types (EventId, RecordedEvent)",+           ""+         ]+      ++ ( if null externalReads+             then []+             else+               [ "must :: Show error => Either error value -> value",+                 "must = either (error . show) id",+                 ""+               ]+         )+      ++ concatMap ownerStubs owners+      ++ concatMap revisionStubs revisions+      ++ concatMap externalReadStubs externalReads+  where+    moduleName = holePrefixFor ctx "ProjectionCatalog" <> ".ProjectionCatalogHoles"+    aggregateSources = nub [aggregateName | owner <- owners, CatalogAggregate aggregateName <- (.sources) owner]+    exports = concatMap ownerExports owners <> concatMap revisionExports revisions <> map externalReadKeyedName externalReads+    ownerExports owner =+      [pascal ((.name) owner) <> "Event" | not (isAggregateSource owner)]+        <> [ownerLiveApplyName owner]+        <> [ownerIdempotencyName owner | (.delivery) owner == DeliverySubscription]+        <> case (.replay) owner of+          ProjectionLiveOnly _ -> []+          ProjectionReplayExplicit -> [ownerReplayApplyName owner] <> [ownerReplayDecodeName owner | not (isAggregateSource owner)]+    ownerStubs owner =+      ["-- Projection owner " <> (.name) owner <> " (order " <> T.pack (show ((.order) owner)) <> ")."]+        <> ["data " <> ownerEventType owner <> " = " <> ownerEventType owner | not (isAggregateSource owner)]+        <> [ownerLiveSignature owner, ownerLiveApplyName owner <> " = error \"HOLE: fill " <> (.name) owner <> " live apply\""]+        <> ( if (.delivery) owner == DeliverySubscription+               then+                 [ ownerIdempotencyName owner <> " :: RecordedEvent -> EventId",+                   ownerIdempotencyName owner <> " = error \"HOLE: return the durable event id for " <> (.name) owner <> "\""+                 ]+               else []+           )+        <> replayStubs owner+        <> [""]+    revisionExports revision =+      concatMap (\target -> [revisionProvisionName revision target, revisionValidateName revision target]) ((.targets) revision)+        <> map (revisionOwnerLiveName revision) (revisionOwners revision)+        <> [revisionReplayName revision, revisionVerificationName revision]+    revisionStubs revision =+      ["-- Projection revision " <> (.name) revision <> "."]+        <> concatMap targetStubs ((.targets) revision)+        <> concatMap liveStubs (revisionOwners revision)+        <> [ revisionReplayName revision <> " :: Catalog.PhysicalTargets -> RecordedEvent -> Tx.Transaction (Either Catalog.ReplayDecodeError Bool)",+             revisionReplayName revision <> " = error \"HOLE: replay revision " <> (.name) revision <> " through PhysicalTargets\"",+             revisionVerificationName revision <> " :: Catalog.PhysicalTargets -> Tx.Transaction (Either Text ())",+             revisionVerificationName revision <> " = error \"HOLE: verify revision " <> (.name) revision <> " staging targets\"",+             ""+           ]+      where+        liveStubs owner =+          [ revisionOwnerLiveName revision owner <> " :: Catalog.PhysicalTargets -> RecordedEvent -> Tx.Transaction ()",+            revisionOwnerLiveName revision owner <> " = error \"HOLE: apply " <> (.name) owner <> " live events for revision " <> (.name) revision <> " through its owned PhysicalTargets\""+          ]+        targetStubs target =+          [ revisionProvisionName revision target <> " :: Catalog.TargetProvisioningContext -> Tx.Transaction ()",+            revisionProvisionName revision target <> " = error \"HOLE: provision target " <> (.target) target <> " for revision " <> (.name) revision <> "\"",+            revisionValidateName revision target <> " :: Catalog.TargetProvisioningContext -> Tx.Transaction (Either [Catalog.TargetSchemaViolation] Catalog.TargetSchemaEvidence)",+            revisionValidateName revision target <> " = error \"HOLE: validate target " <> (.target) target <> " for revision " <> (.name) revision <> "\""+          ]+    externalReadStubs externalRead =+      [ "-- Keyed alternative for external-read " <> (.name) externalRead <> " v" <> T.pack (show ((.version) externalRead)) <> ".",+        "-- Supply typed arguments plus an application-owned private SQL function; do not grant callers access to that inner function.",+        externalReadKeyedName externalRead <> " :: [Catalog.SqlFunctionArgument] -> Catalog.QualifiedFunction -> Int -> Catalog.ExternalReadContract",+        externalReadKeyedName externalRead <> " arguments privateImplementation privateImplementationVersion =",+        "  Catalog.KeyedExternalRead",+        "    " <> smart "mkExternalReadContractId" ((.name) externalRead),+        "    (Catalog.ExternalReadContractVersion " <> T.pack (show ((.version) externalRead)) <> ")",+        "    " <> smart "mkQueryModelId" ((.queryModel) externalRead),+        "    arguments",+        "    (Catalog.QualifiedSqlType " <> tshow ((.resultSchema) externalRead) <> " " <> tshow ((.resultType) externalRead) <> ")",+        "    privateImplementation",+        "    privateImplementationVersion",+        "    " <> tshow (externalReadShape externalRead),+        "    " <> nonEmptyList (smart "mkProjectionRevisionId") ((.compatibleRevisions) externalRead),+        "    " <> T.pack (show ((.surfaceGeneration) externalRead)),+        "    " <> smart "mkClaimSite" ("external-read " <> (.name) externalRead <> " v" <> T.pack (show ((.version) externalRead)) <> " keyed helper"),+        ""+      ]+    replayStubs owner = case (.replay) owner of+      ProjectionLiveOnly _ -> []+      ProjectionReplayExplicit ->+        ( if not (isAggregateSource owner)+            then+              [ ownerReplayDecodeName owner <> " :: RecordedEvent -> Catalog.ReplayDecodeResult " <> ownerEventType owner,+                ownerReplayDecodeName owner <> " = error \"HOLE: classify and decode every " <> (.name) owner <> " source event\""+              ]+            else []+        )+          <> [ ownerReplayApplyName owner <> " :: " <> ownerEventType owner <> " -> RecordedEvent -> Tx.Transaction ()",+               ownerReplayApplyName owner <> " = error \"HOLE: fill " <> (.name) owner <> " replay apply without live-only side effects\""+             ]+    ownerLiveSignature owner =+      ownerLiveApplyName owner <> " :: " <> case (.delivery) owner of+        DeliveryInline -> ownerEventType owner <> " -> RecordedEvent -> Tx.Transaction ()"+        DeliverySubscription -> "RecordedEvent -> Tx.Transaction ()"+    ownerEventType owner = case ownerPrimarySource owner of+      CatalogAggregate aggregateName -> pascal aggregateName <> "Event"+      _ -> pascal ((.name) owner) <> "Event"+    isAggregateSource owner = case ownerPrimarySource owner of CatalogAggregate {} -> True; _ -> False+    ownerPrimarySource owner = case (.sources) owner of source : _ -> source; [] -> CatalogAll+    ownerLiveApplyName owner = "apply" <> pascal ((.name) owner) <> "Live"+    ownerReplayApplyName owner = "apply" <> pascal ((.name) owner) <> "Replay"+    ownerReplayDecodeName owner = "decode" <> pascal ((.name) owner) <> "Replay"+    ownerIdempotencyName owner = lowerFirst (pascal ((.name) owner)) <> "IdempotencyKey"+    revisionProvisionName revision target = "provision" <> pascal ((.name) revision) <> pascal ((.target) target)+    revisionValidateName revision target = "validate" <> pascal ((.name) revision) <> pascal ((.target) target)+    revisionOwners revision = [owner | owner <- owners, (.group) owner == (.group) revision]+    revisionOwnerLiveName revision owner = "apply" <> pascal ((.name) revision) <> pascal ((.name) owner) <> "Live"+    revisionReplayName revision = "apply" <> pascal ((.name) revision) <> "Replay"+    revisionVerificationName revision = "verify" <> pascal ((.name) revision)+    externalReadKeyedName externalRead = lowerFirst (pascal ((.name) externalRead)) <> "V" <> T.pack (show ((.version) externalRead)) <> "KeyedExternalRead"+    externalReadShape externalRead = case [(.shape) readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.queryModel) externalRead] of+      shape : _ -> shape+      [] -> "keiro-dsl invariant: validated external read query is missing"+    smart constructor value = "(must (Catalog." <> constructor <> " " <> tshow value <> "))"+    nonEmptyList _ [] = "error \"keiro-dsl invariant: validated external read has no compatible revisions\""+    nonEmptyList render (value : values) = "(" <> render value <> " :| [" <> T.intercalate ", " (map render values) <> "])"++catalogSourceId :: CatalogSource -> Text+catalogSourceId CatalogAll = "all"+catalogSourceId (CatalogCategory categoryName) = "category:" <> categoryName+catalogSourceId (CatalogAggregate aggregateName) = "aggregate:" <> aggregateName++modulePathFor :: Text -> Text -> FilePath+modulePathFor prefix leaf = T.unpack (T.replace "." "/" prefix <> "/" <> leaf <> ".hs")++readModelStem :: ReadModelNode -> Text+readModelStem = lowerFirst . T.concat . map pascal . T.splitOn "_" . (.name)++emitReadModelTable :: Text -> Text -> ReadModelNode -> Text+emitReadModelTable tableModule stem readModel =+  nl+    [ generatedBanner,+      "module " <> tableModule <> " (" <> qualifiedName <> ") where",+      "",+      "import Data.Text (Text)",+      "import Keiro.Connection (qualifyTable)",+      "",+      "-- The fully-qualified, double-quoted data-table reference.",+      qualifiedName <> " :: Text",+      qualifiedName <> " = qualifyTable " <> tshow ((.schema) readModel) <> " " <> tshow ((.table) readModel)+    ]+  where+    qualifiedName = stem <> "QualifiedTable"++emitReadModelQueryContract :: Text -> TypeGraph -> Text -> ReadModelNode -> ReadModelQueryTypes -> Text+emitReadModelQueryContract queryContractModule graph stem readModel queryPair =+  nl $+    [ generatedBanner,+      "module " <> queryContractModule,+      "  ( " <> queryInputType,+      "  , " <> queryResultType,+      "  ) where",+      ""+    ]+      <> imports+      <> ["" | not (null imports)]+      <> [ "type " <> queryInputType <> " = " <> renderType inputExpression,+           "type " <> queryResultType <> " = " <> renderType resultExpression+         ]+  where+    queryInputType = pascal stem <> "QueryInput"+    queryResultType = pascal stem <> "QueryResult"+    inputExpression = resolve "input" ((.inputLoc) queryPair) ((.input) queryPair)+    resultExpression = resolve "result" ((.resultLoc) queryPair) ((.result) queryPair)+    expressions = [inputExpression, resultExpression]+    plans = map plan expressions+    references = Set.unions (map consumerTypeReferences plans)+    reservedNames = Set.fromList [queryInputType, queryResultType, "Map", "Natural", "Text", "UTCTime", "Value"]+    importPlan = planImportsOrDie queryContractModule reservedNames references+    imports =+      ["import Data.Aeson (Value)" | any typeUsesJson expressions]+        <> ["import Data.Map.Strict (Map)" | any typeUsesMap expressions]+        <> ["import Data.Text (Text)" | any typeUsesText expressions]+        <> ["import Data.Time (UTCTime)" | any typeUsesTime expressions]+        <> ["import Numeric.Natural (Natural)" | any typeUsesNatural expressions]+        <> T.lines (renderPlannedImports importPlan)+    resolve position location expression =+      either+        (\failure -> error ("checked read-model query " <> T.unpack position <> " failed: " <> show failure))+        id+        (resolveTypeExpression graph owner location expression)+      where+        owner = "readmodel '" <> (.name) readModel <> "' query " <> position+    plan expression =+      either+        (error . ("validated read-model consumer type planning failed: " <>) . show)+        id+        (planConsumerType graph expression)+    renderType expression =+      unHaskellTypeOccurrence $+        either+          (error . ("validated read-model consumer type rendering failed: " <>) . show)+          id+          (renderConsumerType importPlan graph expression)++emitReadModelGen :: Context -> Text -> Text -> Text -> Text -> ReadModelNode -> Text+emitReadModelGen ctx readModelModule tableModule readModelHolePrefix stem readModel =+  emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix Nothing Nothing stem readModel++emitReadModelGenWithContract :: Context -> Text -> Text -> Text -> Maybe Text -> Maybe Text -> Text -> ReadModelNode -> Text+emitReadModelGenWithContract ctx readModelModule tableModule readModelHolePrefix resolvedCursor queryContractModule stem readModel =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | emitsLegacyAsync]+      <> [ generatedBanner,+           "module " <> readModelModule <> ".ReadModel",+           "  ( " <> T.intercalate "\n  , " exports,+           "  ) where",+           ""+         ]+      ++ (if not catalogManaged then ["import Data.Functor (void)", "import Effectful (Eff, (:>))"] else [])+      ++ ["import " <> tableModule <> " (" <> qualifiedName <> ")"]+      ++ ["import " <> contractModule <> " (" <> queryInputType <> ", " <> queryResultType <> ")" | Just contractModule <- [queryContractModule]]+      ++ ["import " <> readModelHolePrefix <> ".ReadModelHoles (" <> T.intercalate ", " holeImports <> ")"]+      ++ asyncImports+      ++ [ "import Keiro.ReadModel (" <> readModelImports <> ")"+         ]+      ++ (if not catalogManaged then ["import Keiro.ReadModel.Rebuild qualified as Rebuild", "import Kiroku.Store.Effect (Store)", "import Kiroku.Store.Types (" <> kirokuTypes <> ")"] else [])+      ++ readModelDefinition+      ++ legacyLifecycleDefinitions+      ++ asyncDefinition+  where+    catalogManaged = (.group) readModel /= Nothing+    ownerDerived = (.supply) readModel == OwnerDerivedSupply+    emitsLegacyAsync = not ownerDerived && not catalogManaged && legacyReadModelFeed readModel == Just RmSubscription+    registryName = registryNameFor ((.name) ctx) readModel+    subscriptionName = subscriptionNameFor ((.name) ctx) readModel+    asyncName = registryName <> "-async"+    readModelName = stem <> "ReadModel"+    qualifiedName = stem <> "QualifiedTable"+    registerName = "register" <> pascal stem+    startName = "start" <> pascal stem <> "Rebuild"+    finishName = "finish" <> pascal stem <> "Rebuild"+    abandonName = "abandon" <> pascal stem <> "Rebuild"+    asyncValueName = stem <> "AsyncProjection"+    queryInputType = pascal stem <> "QueryInput"+    queryResultType = pascal stem <> "QueryResult"+    queryName = stem <> "Query"+    applyName = "apply" <> pascal stem+    exports =+      [ readModelName,+        qualifiedName+      ]+        ++ (if not catalogManaged then [registerName, startName, finishName, abandonName] else [])+        ++ [asyncValueName | emitsLegacyAsync]+    holeImports = (if queryContractModule == Nothing then [queryInputType, queryResultType] else []) ++ [queryName] ++ [applyName | emitsLegacyAsync]+    asyncImports = ["import Keiro.Projection (AsyncProjection (..))" | emitsLegacyAsync]+    readModelImports =+      if ownerDerived+        then+          T.intercalate+            ", "+            ( ["QueryCursorAuthority (..)", "ReadModel", "ReadModelBlueprint (..)"]+                <> ( case (.freshness) readModel of+                       FreshnessImmediate -> ["immediateReadModel"]+                       FreshnessWaitForHead {} -> ["HeadScope (..)", "headWaitingReadModel"]+                   )+                <> if not catalogManaged then ["ReadModelMetadata", "registerReadModel"] else []+            )+        else+          "ConsistencyMode (..), ReadModel (..)"+            <> if catalogManaged+              then ", StrongScope (..)"+              else ", ReadModelMetadata, StrongScope (..), registerReadModel"+    kirokuTypes = case legacyReadModelFeed readModel of+      Just RmSubscription -> "GlobalPosition, RecordedEvent (..)"+      _ -> "GlobalPosition"+    projectionNames = case legacyReadModelFeed readModel of+      Just RmSubscription -> "[" <> tshow asyncName <> "]"+      _ -> "[]"+    readModelDefinition =+      [ "",+        readModelName <> " :: ReadModel " <> queryInputType <> " " <> queryResultType,+        readModelName <> " ="+      ]+        <> if ownerDerived+          then truthfulDefinition+          else legacyDefinition+    truthfulDefinition =+      ( case (.freshness) readModel of+          FreshnessImmediate -> ["  immediateReadModel " <> readModelBlueprintName]+          FreshnessWaitForHead scope ->+            [ "  case headWaitingReadModel " <> headScopeExpr scope <> " " <> readModelBlueprintName <> " of",+              "    Left definitionError -> error (\"keiro-dsl generated an invalid waiting read model: \" <> show definitionError)",+              "    Right model -> model"+            ]+      )+        <> [ "",+             readModelBlueprintName <> " :: ReadModelBlueprint " <> queryInputType <> " " <> queryResultType,+             readModelBlueprintName <> " =",+             "  ReadModelBlueprint",+             "    { name = " <> tshow registryName,+             "    , tableName = " <> tshow ((.table) readModel),+             "    , schema = " <> tshow ((.schema) readModel),+             "    , version = " <> tshow' ((.version) readModel),+             "    , shapeHash = " <> tshow ((.shape) readModel),+             "    , cursorAuthority = " <> maybe "NoQueryCursor" (("DurableQueryCursor " <>) . tshow) resolvedCursor,+             "    , query = " <> queryName,+             "    }"+           ]+    legacyDefinition =+      [ "  ReadModel",+        "    { name = " <> tshow registryName,+        "    , tableName = " <> tshow ((.table) readModel),+        "    , schema = " <> tshow ((.schema) readModel),+        "    , subscriptionName = " <> tshow subscriptionName,+        "    , version = " <> tshow' ((.version) readModel),+        "    , shapeHash = " <> tshow ((.shape) readModel),+        "    , defaultConsistency = " <> consistencyExpr legacyConsistency,+        "    , strongScope = " <> scopeExpr legacyScope,+        "    , query = " <> queryName,+        "    }"+      ]+    readModelBlueprintName = stem <> "ReadModelBlueprint"+    legacyConsistency = fromMaybe Eventual (legacyReadModelConsistency readModel)+    legacyScope = legacyReadModelScope readModel+    headScopeExpr RmEntireLog = "EntireVisibleLog"+    headScopeExpr (RmCategory categoryName) = "(CategoryVisibleHead " <> tshow categoryName <> ")"+    legacyLifecycleDefinitions+      | not catalogManaged =+          [ "",+            "-- Call once at projection startup before serving queries.",+            registerName <> " :: (Store :> es) => Eff es ()",+            registerName <> " =",+            "  void (registerReadModel " <> tshow registryName <> " " <> tshow' ((.version) readModel) <> " " <> tshow ((.shape) readModel) <> ")",+            "",+            startName <> " :: (Store :> es) => GlobalPosition -> Eff es ReadModelMetadata",+            startName <> " =",+            "  Rebuild.startRebuild " <> readModelName <> " " <> projectionNames,+            "",+            finishName <> " :: (Store :> es) => GlobalPosition -> Eff es (Either Rebuild.RebuildError ReadModelMetadata)",+            finishName <> " =",+            "  Rebuild.finishRebuild " <> readModelName <> " " <> projectionNames,+            "",+            abandonName <> " :: (Store :> es) => Eff es ReadModelMetadata",+            abandonName <> " = Rebuild.abandonRebuild " <> readModelName+          ]+      | otherwise = []+    asyncDefinition+      | emitsLegacyAsync =+          [ "",+            asyncValueName <> " :: AsyncProjection",+            asyncValueName <> " =",+            "  AsyncProjection",+            "    { name = " <> tshow asyncName,+            "    , readModelName = " <> tshow registryName,+            "    , subscriptionName = " <> tshow subscriptionName,+            "    , applyRecorded = " <> applyName,+            "    , idempotencyKey = \\recorded -> recorded.eventId",+            "    }"+          ]+      | otherwise = []+    consistencyExpr Strong = "Strong"+    consistencyExpr Eventual = "Eventual"+    scopeExpr Nothing = "EntireLog"+    scopeExpr (Just RmEntireLog) = "EntireLog"+    scopeExpr (Just (RmCategory categoryName)) = "CategoryHead " <> tshow categoryName++emitReadModelHoles :: Text -> Text -> Text -> ReadModelNode -> Text+emitReadModelHoles tableModule readModelHolePrefix stem readModel =+  nl $+    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",+      "module " <> readModelHolePrefix <> ".ReadModelHoles",+      "  ( " <> T.intercalate "\n  , " exports,+      "  ) where",+      "",+      "import " <> tableModule <> " (" <> qualifiedName <> ")",+      "import Hasql.Transaction qualified as Tx"+    ]+      ++ ["import Kiroku.Store.Types (RecordedEvent(..))" | emitsLegacyAsync]+      ++ [ "",+           "-- HOLE: replace these aliases with the real query input and result types.",+           "type " <> queryInputType <> " = ()",+           "type " <> queryResultType <> " = ()",+           "",+           "-- HOLE: query " <> qualifiedTableLiteral readModel <> " via " <> qualifiedName <> "; never rely on search_path.",+           "-- Declared columns:"+         ]+      ++ map (("--   " <>) . readModelColumnDoc) ((.columns) readModel)+      ++ [ queryName <> " :: " <> queryInputType <> " -> Tx.Transaction " <> queryResultType,+           queryName <> " _input = " <> qualifiedName <> " `seq` error " <> tshow ("HOLE: fill " <> (.name) readModel <> " query")+         ]+      ++ applyStub+  where+    qualifiedName = stem <> "QualifiedTable"+    queryInputType = pascal stem <> "QueryInput"+    queryResultType = pascal stem <> "QueryResult"+    queryName = stem <> "Query"+    applyName = "apply" <> pascal stem+    emitsLegacyAsync = (.group) readModel == Nothing && legacyReadModelFeed readModel == Just RmSubscription+    exports = [queryInputType, queryResultType, queryName] ++ [applyName | emitsLegacyAsync]+    applyStub+      | emitsLegacyAsync =+          [ "",+            "-- HOLE: apply one recorded event; runtime deduplication makes redelivery safe.",+            applyName <> " :: RecordedEvent -> Tx.Transaction ()",+            applyName <> " _recorded = error " <> tshow ("HOLE: fill " <> (.name) readModel <> " async apply")+          ]+      | otherwise = []++emitTypedReadModelHoles :: Text -> Text -> Text -> Text -> ReadModelNode -> Text+emitTypedReadModelHoles tableModule queryContractModule readModelHolePrefix stem readModel =+  nl $+    [ "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never overwrites it.",+      "module " <> readModelHolePrefix <> ".ReadModelHoles",+      "  ( " <> T.intercalate "\n  , " exports,+      "  ) where",+      "",+      "import " <> tableModule <> " (" <> qualifiedName <> ")",+      "import " <> queryContractModule <> " (" <> queryInputType <> ", " <> queryResultType <> ")",+      "import Hasql.Transaction qualified as Tx"+    ]+      ++ ["import Kiroku.Store.Types (RecordedEvent(..))" | emitsLegacyAsync]+      ++ [ "",+           "-- HOLE: query " <> qualifiedTableLiteral readModel <> " via " <> qualifiedName <> "; never rely on search_path.",+           "-- The generated QueryContract owns query input/result type identity.",+           "-- Declared columns:"+         ]+      ++ map (("--   " <>) . readModelColumnDoc) ((.columns) readModel)+      ++ [ queryName <> " :: " <> queryInputType <> " -> Tx.Transaction " <> queryResultType,+           queryName <> " _input = " <> qualifiedName <> " `seq` error " <> tshow ("HOLE: fill " <> (.name) readModel <> " query")+         ]+      ++ applyStub+  where+    qualifiedName = stem <> "QualifiedTable"+    queryInputType = pascal stem <> "QueryInput"+    queryResultType = pascal stem <> "QueryResult"+    queryName = stem <> "Query"+    applyName = "apply" <> pascal stem+    emitsLegacyAsync = (.group) readModel == Nothing && legacyReadModelFeed readModel == Just RmSubscription+    exports = [queryName] ++ [applyName | emitsLegacyAsync]+    applyStub+      | emitsLegacyAsync =+          [ "",+            "-- HOLE: apply one recorded event; runtime deduplication makes redelivery safe.",+            applyName <> " :: RecordedEvent -> Tx.Transaction ()",+            applyName <> " _recorded = error " <> tshow ("HOLE: fill " <> (.name) readModel <> " async apply")+          ]+      | otherwise = []++qualifiedTableLiteral :: ReadModelNode -> Text+qualifiedTableLiteral readModel = quoteSqlIdentifier ((.schema) readModel) <> "." <> quoteSqlIdentifier ((.table) readModel)++quoteSqlIdentifier :: Text -> Text+quoteSqlIdentifier identifier = "\"" <> T.replace "\"" "\"\"" identifier <> "\""++readModelColumnDoc :: RmColumn -> Text+readModelColumnDoc columnDecl =+  (.rmcName) columnDecl+    <> " "+    <> (.rmcType) columnDecl+    <> if (.rmcRequired) columnDecl then " NOT NULL" else ""++--------------------------------------------------------------------------------+-- Router + shared worker-policy lowering (EP-108)+--------------------------------------------------------------------------------++scaffoldRouter :: Context -> RouterNode -> [ScaffoldModule]+scaffoldRouter ctx router =+  [ ScaffoldModule+      { path = modulePathFor genPrefix "Router",+        text = emitRouterGen genPrefix router,+        kind = Generated,+        origin = routerOrigin+      },+    ScaffoldModule+      { path = modulePathFor holePrefix "RouterHoles",+        text = emitRouterHoles holePrefix router,+        kind = HoleStub,+        origin = routerOrigin+      }+  ]+  where+    genPrefix = genPrefixFor ctx ((.id) router)+    holePrefix = holePrefixFor ctx ((.id) router)+    routerOrigin = nodeOrigin "router" ((.id) router) ((.loc) router)++-- | Service-aware router generation preserves the historical custom resolver+-- vertical byte-for-byte, while a checked declarative selection becomes one+-- fully generated module and owns no selection hole.+scaffoldRouterForService :: Context -> CheckedService -> RouterNode -> [ScaffoldModule]+scaffoldRouterForService ctx service router = case (.source) ((.resolve) router) of+  ResolveDeclarative {} ->+    [ ScaffoldModule+        { path = modulePathFor genPrefix "Router",+          text = emitDeclarativeRouterGen ctx graph selection readModel targetAggregate targetCommand genPrefix router,+          kind = Generated,+          origin = routerOrigin+        }+    ]+  _ -> scaffoldRouter ctx router+  where+    spec = checkedSpec service+    genPrefix = genPrefixFor ctx ((.id) router)+    routerOrigin = nodeOrigin "router" ((.id) router) ((.loc) router)+    graph = case checkedTypeGraph service of+      Left errors -> error ("checked declarative router type graph failed: " <> show errors)+      Right value -> value+    selection = case checkRouterSelection (checkedLanguageContract service) graph spec router of+      Left diagnostics -> error ("checked declarative router selection failed: " <> show diagnostics)+      Right value -> value+    readModel = case [value | NReadModel value <- (.nodes) spec, (.name) value == (.name) ((.query) selection)] of+      [value] -> value+      _ -> error "checked declarative router read model disappeared"+    targetAggregate = case [aggregate | NAggregate aggregate <- (.nodes) spec, (.name) aggregate == (.target) selection] of+      [aggregate] -> aggregate+      _ -> error "checked declarative router target aggregate disappeared"+    targetCommand = case [command | command <- (.commands) targetAggregate, (.name) command == (.command) selection] of+      [command] -> command+      _ -> error "checked declarative router target command disappeared"++emitRouterGen :: Text -> RouterNode -> Text+emitRouterGen genPrefix router =+  nl $+    [ generatedBanner,+      "module " <> genPrefix <> ".Router",+      "  ( " <> stem <> "Name",+      "  , " <> stem <> "WorkerOptions",+      "  ) where",+      "",+      "import Data.Text (Text)"+    ]+      ++ workerPolicyImports ((.poison) router)+      ++ [ "",+           "-- The STABLE router name. It participates in every target-keyed",+           "-- deterministicRouterCommandId; renaming it re-keys replayed dispatches.",+           stem <> "Name :: Text",+           stem <> "Name = " <> tshow ((.name) router),+           "",+           "-- Runtime-owned dispatch id inputs: (name, key, sourceEventId,",+           "-- targetStreamName, occurrence). Target-keyed, not positional.",+           "",+           "-- Node-level worker policy lowered from the spec. Pass this value to",+           "-- Keiro.Router.runRouterWorkerWith; do not silently use defaultWorkerOptions."+         ]+      ++ workerOptionsLines (stem <> "WorkerOptions") ((.rejected) router) ((.poison) router)+  where+    stem = lowerFirst ((.id) router)++emitDeclarativeRouterGen :: Context -> TypeGraph -> CheckedRouterSelection -> ReadModelNode -> Aggregate -> Command -> Text -> RouterNode -> Text+emitDeclarativeRouterGen ctx graph selection readModel targetAggregate targetCommand genPrefix router =+  nl $+    [ generatedBanner,+      "module " <> genPrefix <> ".Router",+      "  ( " <> stem <> "Name",+      "  , " <> stem <> "WorkerOptions",+      "  , " <> stem <> "SelectionFingerprint",+      "  , " <> stem <> "SelectionContract",+      "  , " <> stem <> "Select",+      "  , " <> stem,+      "  ) where",+      "",+      "import Data.Text (Text)",+      "import Effectful (Eff, IOE, (:>))",+      "import " <> structuralProjectionModule ctx <> " qualified as StructuralProjections",+      "import " <> queryContractModule <> " (" <> queryInputType <> ")",+      "import " <> readModelModule <> ".ReadModel qualified as SelectionQuery",+      "import " <> targetModule <> ".Domain qualified as TargetDomain",+      "import " <> targetModule <> ".EventStream qualified as TargetStream"+    ]+      <> ["import " <> targetModule <> ".Projection qualified as TargetProjection" | not (null ((.projections) router))]+      <> [ "import Keiki.Core (HsPred, fieldWitnessGet)",+           "import Keiro.ProcessManager (PMCommand (..), PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))",+           "import Keiro.ReadModel (runQuery)",+           "import Keiro.Router",+           "  ( DeclarativeRouter (..)",+           "  , EmptySelectionPolicy (..)",+           "  , PartialDispatchPolicy (..)",+           "  , RedeliveryPolicy (..)",+           "  , RouterSelectionContract (..)",+           "  , RouterSelectionFailure (..)",+           "  , SelectionDedupe (..)",+           "  , SelectionFailurePolicy (..)",+           "  , SelectionFingerprint (..)",+           "  , SelectionIdentity (..)",+           "  , SelectionOrder (..)",+           "  , mkRecipientLimit",+           "  , mkSelectionVersion",+           "  )",+           "import Keiro.Stream (entityStream)",+           "import Kiroku.Store.Effect (Store)",+           "import Shibuya.Core.Ack (RetryDelay (..))"+         ]+      <> ["import Shibuya.Core.Types (Envelope)" | (.poison) router /= PolHalt]+      <> [ "",+           "-- The STABLE router name. It remains part of every target-keyed",+           "-- deterministic router command id; selection metadata never re-keys dispatches.",+           stem <> "Name :: Text",+           stem <> "Name = " <> tshow ((.name) router),+           "",+           "-- SHA-256 of the checked selection semantics (locations and formatting excluded).",+           stem <> "SelectionFingerprint :: Text",+           stem <> "SelectionFingerprint = " <> tshow ((.fingerprint) selection),+           "",+           stem <> "SelectionContract :: RouterSelectionContract",+           stem <> "SelectionContract =",+           "  RouterSelectionContract",+           "    { identity = SelectionIdentity " <> tshow ((.identity) selection),+           "    , version = checkedSelectionVersion",+           "    , fingerprint = SelectionFingerprint " <> stem <> "SelectionFingerprint",+           "    , limit = checkedRecipientLimit",+           "    , order = OrderByTargetStream",+           "    , dedupe = DedupeByTargetStream",+           "    , emptyPolicy = " <> renderCheckedEmptyPolicy ((.emptyPolicy) selection),+           "    , failurePolicy = " <> renderCheckedFailurePolicy ((.failurePolicy) selection),+           "    , redeliveryPolicy = StableUnion",+           "    , partialPolicy = RetainSuccesses",+           "    }",+           "  where",+           "    checkedSelectionVersion = case mkSelectionVersion " <> T.pack (show ((.version) selection)) <> " of",+           "      Right value -> value",+           "      Left _ -> error \"keiro-dsl emitted a non-positive checked selection version\"",+           "    checkedRecipientLimit = case mkRecipientLimit " <> T.pack (show ((.limit) selection)) <> " of",+           "      Right value -> value",+           "      Left _ -> error \"keiro-dsl emitted a non-positive checked recipient limit\"",+           "",+           stem <> "Select ::",+           "  (IOE :> es, Store :> es) =>",+           "  " <> queryInputType <> " ->",+           "  Eff es (Either RouterSelectionFailure [PMCommand TargetDomain." <> targetName <> "Command])",+           stem <> "Select input = do",+           "  queryResult <- runQuery Nothing SelectionQuery." <> readModelValue <> " input",+           "  pure $ case queryResult of",+           "    Left _ -> Left (SelectionQueryFailed " <> tshow ("read-model " <> (.name) ((.query) selection) <> " query failed") <> ")",+           "    Right rows ->",+           "      Right",+           "        [ PMCommand",+           "            { target = entityStream TargetStream." <> targetCategory <> " (" <> renderCheckedScalar graph ((.recipient) selection) <> ")",+           "            , command = " <> renderSelectionCommand graph selection targetCommand,+           "            }",+           "        | row <- rows",+           "        , " <> renderCheckedScalar graph ((.predicate) selection),+           "        ]",+           "",+           stem <> " ::",+           "  (IOE :> es, Store :> es) =>",+           "  DeclarativeRouter",+           "    " <> queryInputType,+           "    (HsPred TargetDomain." <> targetName <> "Regs TargetDomain." <> targetName <> "Command)",+           "    TargetDomain." <> targetName <> "Regs",+           "    TargetDomain." <> targetName <> "Vertex",+           "    TargetDomain." <> targetName <> "Command",+           "    TargetDomain." <> targetName <> "Event",+           "    es",+           stem <> " =",+           "  DeclarativeRouter",+           "    { name = " <> stem <> "Name",+           "    , key = \\input -> " <> renderCheckedScalar graph ((.key) selection),+           "    , selectionContract = " <> stem <> "SelectionContract",+           "    , select = " <> stem <> "Select",+           "    , targetEventStream = TargetStream." <> targetEventStream,+           "    , targetProjections = const " <> renderTargetProjections ((.projections) router),+           "    }",+           "",+           "-- Node-level worker policy. Pair it with runDeclarativeRouterWorkerWith.",+           "-- Selection empty/failure policy remains in the generated selection contract."+         ]+      <> workerOptionsLines (stem <> "WorkerOptions") ((.rejected) router) ((.poison) router)+  where+    stem = lowerFirst ((.id) router)+    targetName = (.name) targetAggregate+    targetModule = genPrefixFor ctx targetName+    targetCategory = lowerFirst targetName <> "CommandCategory"+    targetEventStream = lowerFirst targetName <> "EventStream"+    readModelStemValue = readModelStem readModel+    queryInputType = pascal readModelStemValue <> "QueryInput"+    queryNodeSegment = pascal ((.name) readModel)+    queryContractModule = genPrefixFor ctx queryNodeSegment <> ".QueryContract"+    readModelModule = genPrefixFor ctx queryNodeSegment+    readModelValue = readModelStemValue <> "ReadModel"+    renderTargetProjections [] = "[]"+    renderTargetProjections names = "[" <> T.intercalate ", " ["TargetProjection." <> lowerFirst name <> "Projection" | name <- names] <> "]"++renderCheckedEmptyPolicy :: CheckedEmptySelectionPolicy -> Text+renderCheckedEmptyPolicy = \case+  CheckedEmptyAck -> "EmptyAck"+  CheckedEmptyRetry -> "EmptyRetry"+  CheckedEmptyDeadLetter -> "EmptyDeadLetter"+  CheckedEmptyHalt -> "EmptyHalt"++renderCheckedFailurePolicy :: CheckedSelectionFailurePolicy -> Text+renderCheckedFailurePolicy = \case+  CheckedFailureRetry -> "FailureRetry"+  CheckedFailureDeadLetter -> "FailureDeadLetter"+  CheckedFailureHalt -> "FailureHalt"++renderCheckedScalar :: TypeGraph -> CheckedScalarExpr -> Text+renderCheckedScalar graph expression = case (.node) expression of+  CheckedPath root segments ->+    "(fieldWitnessGet StructuralProjections."+      <> witnessName segments+      <> " "+      <> rootName root+      <> ")"+  CheckedTextLiteral value -> tshow value+  CheckedIntegralLiteral value -> T.pack (show value)+  CheckedBoolLiteral value -> if value then "True" else "False"+  CheckedCompare operator left right ->+    "(" <> renderCheckedScalar graph left <> " " <> comparison operator <> " " <> renderCheckedScalar graph right <> ")"+  CheckedAnd left right -> "(" <> renderCheckedScalar graph left <> " && " <> renderCheckedScalar graph right <> ")"+  CheckedOr left right -> "(" <> renderCheckedScalar graph left <> " || " <> renderCheckedScalar graph right <> ")"+  where+    rootName SelectionInput = "input"+    rootName SelectionRow = "row"+    comparison OpEq = "=="+    comparison OpNeq = "/="+    comparison OpLt = "<"+    comparison OpLe = "<="+    comparison OpGt = ">"+    comparison OpGe = ">="+    witnessName [] = error "checked scalar path contained no fields"+    witnessName path@(first : _) =+      fromMaybe+        (error "checked scalar path has no generated structural witness")+        (projectionWitnessName graph ((.owner) first) pointer)+      where+        pointer = T.concat ["/" <> escapePointer ((.wireKey) segment) | segment <- path]++renderSelectionCommand :: TypeGraph -> CheckedRouterSelection -> Command -> Text+renderSelectionCommand graph selection command =+  "TargetDomain."+    <> (.name) command+    <> " (TargetDomain."+    <> (.name) command+    <> "Data"+    <> T.concat [" (" <> renderCheckedScalar graph (commandExpression field) <> ")" | field <- (.fields) command]+    <> ")"+  where+    commandExpression field =+      fromMaybe+        (error "checked declarative router command field disappeared")+        (Map.lookup ((.name) field) ((.commandFields) selection))++emitRouterHoles :: Text -> RouterNode -> Text+emitRouterHoles holePrefix router =+  nl+    [ "-- HAND-OWNED hole module for the router's behaviour-bearing bodies.",+      "-- keiro-dsl creates it once and never overwrites it.",+      "module " <> holePrefix <> ".RouterHoles () where",+      "",+      "-- HOLE resolve :: " <> (.name) ((.input) router) <> " -> Eff es [PMCommand targetCommand]",+      "--   Spec source: " <> resolveSourceText ((.source) ((.resolve) router)) <> ".",+      "--   The spec's 'stable' keyword acknowledges that retry attempts accumulate",+      "--   the UNION of resolved target identities. Keep the recipient set stable",+      "--   for a source event whenever an exact recipient set matters.",+      "-- HOLE router value: assemble Keiro.Router.Router with name = " <> lowerFirst ((.id) router) <> "Name,",+      "--   key, resolve, targetEventStream, and targetProjections; run it with",+      "--   runRouterWorkerWith " <> lowerFirst ((.id) router) <> "WorkerOptions.",+      "-- HOLE targetProjections: spec projections = " <> renderNames ((.projections) router) <> ".",+      "-- NOTE on-duplicate AckOk is sound because Keiro.Router confirms a duplicate",+      "--   event id against the TARGET stream via confirmBenignDuplicate before",+      "--   returning PMCommandDuplicate. Hand-rolled dispatch paths must do likewise."+    ]+  where+    renderNames names = "[" <> T.intercalate ", " names <> "]"++resolveSourceText :: ResolveSource -> Text+resolveSourceText (ResolveReadModel name) = "read-model " <> name <> " (typically Keiro.ReadModel.runQuery)"+resolveSourceText ResolveHole = "typed resolver hole"+resolveSourceText (ResolveDeclarative selection) = "declarative selection " <> (.identity) selection++workerPolicyImports :: PolicyChoice -> [Text]+workerPolicyImports poison =+  [ "import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))",+    "import Shibuya.Core.Ack (RetryDelay (..))"+  ]+    ++ if poison == PolHalt+      then []+      else ["import Effectful (Eff)", "import Shibuya.Core.Types (Envelope)"]++workerOptionsLines :: Text -> PolicyChoice -> PolicyChoice -> [Text]+workerOptionsLines valueName rejected poison =+  [ valueName <> signature,+    valueName <> argument <> " =",+    "  WorkerOptions",+    "    { poisonPolicy = " <> poisonExpr <> ",",+    "      rejectedCommandPolicy = " <> rejectedExpr rejected <> ",",+    "      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning",+    "      metrics = Nothing -- runtime configuration; install at call site",+    "    }"+  ]+  where+    signature = case poison of+      PolHalt -> " :: WorkerOptions es msg"+      _ -> " :: (Envelope msg -> Eff es ()) -> WorkerOptions es msg"+    argument = case poison of+      PolHalt -> ""+      _ -> " poisonCallback"+    poisonExpr = case poison of+      PolHalt -> "PoisonHalt"+      PolDeadLetter -> "PoisonDeadLetter poisonCallback"+      PolSkip -> "PoisonSkip poisonCallback"+    rejectedExpr = \case+      PolHalt -> "RejectedHalt"+      PolDeadLetter -> "RejectedDeadLetter"+      PolSkip -> "RejectedSkip"++--------------------------------------------------------------------------------+-- Process manager + durable timer (EP-3)+--------------------------------------------------------------------------------++-- | Emit the symbol-free deterministic wiring for a process manager + its timer+-- into a @Generated@ module, plus a create-if-absent @ProcessHoles@ module for the+-- behaviour-bearing bodies (the @handle@ reaction, the deadline window, and the+-- fire command). The @Generated@ module contains no keiki symbolic operator (the+-- saga's transducer is the separate aggregate hole), so the firewall invariant+-- holds. The timer worker uses the spec's @max-attempts@ ceiling, never the+-- dangerous @defaultTimerWorkerOptions@ (@Nothing@) default.+scaffoldProcess :: Context -> ProcessNode -> [ScaffoldModule]+scaffoldProcess ctx p =+  [ ScaffoldModule+      { path = T.unpack (T.replace "." "/" genPrefix <> "/Process.hs"),+        text = emitProcessGen sagaGenPrefix genPrefix holePrefix p,+        kind = Generated,+        origin = nodeOrigin "process" ((.id) p) ((.loc) p)+      },+    ScaffoldModule+      { path = T.unpack (T.replace "." "/" holePrefix <> "/ProcessHoles.hs"),+        text = emitProcessHoles genPrefix holePrefix p,+        kind = HoleStub,+        origin = nodeOrigin "process" ((.id) p) ((.loc) p)+      }+  ]+  where+    genPrefix = genPrefixFor ctx ((.id) p)+    holePrefix = holePrefixFor ctx ((.id) p)+    sagaGenPrefix = genPrefixFor ctx (pascal ((.agg) ((.saga) p)))++emitProcessGen :: Text -> Text -> Text -> ProcessNode -> Text+emitProcessGen sagaGenPrefix genPrefix _holePrefix p =+  nl $+    [ generatedBanner,+      "module " <> genPrefix <> ".Process",+      "  ( " <> lo <> "ProcessName",+      "  , " <> lo <> "Category",+      "  , " <> lo <> "ProcessWorkerOptions",+      "  , " <> lo <> "TimerRequest",+      "  , " <> lo <> "FireOutcome",+      "  ) where",+      "",+      "import Data.Aeson (Value, object, (.=))",+      "import Data.Text (Text)",+      "import qualified Data.Text as T",+      "import Data.Time (UTCTime)",+      "import Data.UUID (UUID)",+      "import qualified Data.UUID.V5 as UUID.V5",+      "import " <> sagaGenPrefix <> ".EventStream (" <> sagaEventStreamType <> ")",+      "import Keiro.Command (CommandError (..))",+      "import Keiro.Stream qualified as Stream",+      "import Keiro.Timer (TimerId (..), TimerRequest (..))"+    ]+      ++ workerPolicyImports ((.poison) p)+      ++ [ "",+           "-- The define-once ProcessManager name (hole-kind 5: referenced, never retyped).",+           lo <> "ProcessName :: Text",+           lo <> "ProcessName = " <> tshow ((.name) p),+           "",+           "-- The validated saga stream category (hole-kind 5: referenced, never retyped).",+           "-- Saga streams are '<category>-<correlationId>' via Keiro.Stream.entityStream.",+           "-- categoryUnsafe is safe here because keiro-dsl check proved the literal legal.",+           lo <> "Category :: Stream.StreamCategory " <> sagaEventStreamType,+           lo <> "Category = Stream.categoryUnsafe " <> tshow categoryName,+           "",+           "-- Node-level worker policy lowered from the spec. Pass this value to",+           "-- Keiro.ProcessManager.runProcessManagerWorkerWith."+         ]+      ++ workerOptionsLines (lo <> "ProcessWorkerOptions") ((.rejected) p) ((.poison) p)+      ++ [ "",+           "-- The deterministic timer-request builder: id derived from the correlation",+           "-- key (hole-kind 1), processManagerName referenced, payload from the spec.",+           "-- (timer id derived as uuidv5 of " <> tshow ((.prefix) ((.id) timer)) <> " <> correlationId)",+           lo <> "TimerRequest :: Text -> UTCTime -> TimerRequest",+           lo <> "TimerRequest correlationId fireAtTime =",+           "  TimerRequest",+           "    { timerId = TimerId (namedUuid (" <> tshow ((.prefix) ((.id) timer)) <> " <> correlationId))",+           "    , processManagerName = " <> lo <> "ProcessName",+           "    , correlationId = correlationId",+           "    , fireAt = fireAtTime",+           "    , payload = " <> payloadExpr ((.payload) timer),+           "    }",+           "",+           "-- The timer-fire disposition table (hole-kind 2), derived from the spec.",+           "-- on-reject => " <> showOutcome ((.onReject) fd) <> " is the benign inversion.",+           "-- A duplicate append reaches on-error unless it is confirmed against the",+           "-- target stream. Use Keiro.ProcessManager.confirmBenignDuplicate:",+           "--   StreamName -> EventId -> CommandError -> Eff es Bool",+           "-- Fold True into the duplicate result and surface False as the failure.",+           lo <> "FireOutcome :: Either CommandError a -> Maybe ()",+           lo <> "FireOutcome result = case result of",+           "  Right{} -> " <> outcomeToMaybe ((.onOk) fd),+           "  Left CommandRejected -> " <> outcomeToMaybe ((.onReject) fd),+           "  Left (CommandAmbiguous _) -> " <> outcomeToMaybe ((.onAmbiguous) fd) <> "  -- explicit definition-bug arm",+           "  Left{} -> " <> outcomeToMaybe ((.onError) fd),+           "",+           "-- max-attempts = " <> tshow' ((.maxAttempts) timer) <> ", dead-letter = " <> tshow ((.deadLetter) timer),+           "-- (the timer worker must pass Just " <> tshow' ((.maxAttempts) timer) <> " to runTimerWorkerWith, never the",+           "--  defaultTimerWorkerOptions Nothing ceiling that retries forever).",+           "",+           "-- deterministic v5 UUID of a correlation-keyed string (hole-kind 1).",+           "namedUuid :: Text -> UUID",+           "namedUuid v = UUID.V5.generateNamed UUID.V5.namespaceURL (map (fromIntegral . fromEnum) (T.unpack v))"+         ]+  where+    lo = lowerFirst ((.id) p)+    sagaEventStreamType = pascal ((.agg) ((.saga) p)) <> "EventStreamDef"+    categoryName = staticCategory ("process " <> (.id) p) ((.category) ((.saga) p))+    timer = (.timer) p+    fd = (.disposition) ((.fire) timer)++-- | The timer payload, restricted to the spec's literal (@name=\"value\"@)+-- bindings so it compiles in the deterministic builder. Bare fields and+-- ref-valued bindings are input-driven (the agent-written hole), not emitted.+payloadExpr :: [FieldBinding] -> Text+payloadExpr fs = case [b | b <- fs, isLiteral b] of+  [] -> "object []"+  lits -> "object [ " <> T.intercalate ", " (map kv lits) <> " ]"+  where+    isLiteral b = maybe False (const True) ((.value) b >>= stripWrappingQuotes)+    kv b = tshow ((.name) b) <> " .= (" <> maybe "\"\"" tshow ((.value) b >>= stripWrappingQuotes) <> " :: Value)"+    stripWrappingQuotes value = T.stripPrefix "\"" value >>= T.stripSuffix "\""++showOutcome :: FireOutcome -> Text+showOutcome OFired = "Fired"+showOutcome ORetry = "Retry"++outcomeToMaybe :: FireOutcome -> Text+outcomeToMaybe OFired = "Just ()  -- Fired"+outcomeToMaybe ORetry = "Nothing  -- Retry"++emitProcessHoles :: Text -> Text -> ProcessNode -> Text+emitProcessHoles _genPrefix holePrefix p =+  nl+    [ "-- HAND-OWNED hole module for the process manager's behaviour-bearing bodies.",+      "-- keiro-dsl creates it once and never overwrites it.",+      "module " <> holePrefix <> ".ProcessHoles () where",+      "",+      "-- HOLE handle: build the ProcessManagerAction (the self-advance",+      "--   '" <> (.advCommand) ((.advance) ((.handle) p)) <> "', the dispatch(es), and the timer) from the input.",+      "-- HOLE streams: build streamFor with entityStream " <> lowerFirst ((.id) p) <> "Category;",+      "--   build target streams with entityStream " <> lowerFirst ((.target) p) <> "CommandCategory. Never concatenate raw stream names.",+      "-- HOLE window: the deadline policy, e.g. surgeWindow :: NominalDiffTime;",+      "--   surgeDeadline observedAt = addUTCTime surgeWindow observedAt  (TIME INJECTED).",+      "-- HOLE fire command: construct " <> (.command) ((.fire) ((.timer) p)) <> " for the timer fire,",+      "--   keyed by correlationId; the fired-event-id is the deterministic uuidv5 of",+      "--   " <> tshow ((.prefix) ((.firedEventId) ((.fire) ((.timer) p)))) <> " <> correlationId.",+      "-- NOTE on-duplicate AckOk is sound because the runtime confirms a duplicate",+      "--   event id against the TARGET stream via confirmBenignDuplicate before",+      "--   returning PMCommandDuplicate. Its effective signature is:",+      "--     StreamName -> EventId -> CommandError -> Eff es Bool",+      "--   Hand-rolled paths must call it with the target stream and attempted event id,",+      "--   fold True into the duplicate result, and surface False as the original failure.",+      "--   Never pattern-match DuplicateEvent as success: event ids are globally unique."+    ]++--------------------------------------------------------------------------------+-- Domain module+--------------------------------------------------------------------------------++emitDomain :: Agg -> Text+emitDomain a =+  nl $+    renderGeneratedLanguagePragmas+      ( [ExtDeriveAnyClass | hasSnapshot a]+          <> [ExtDuplicateRecordFields | domainNeedsDuplicateRecordFields a]+          <> [ExtTemplateHaskell]+      )+      ++ [ generatedBanner,+           "module " <> (.genPrefix) a <> ".Domain where",+           ""+         ]+      ++ ["import Data.Aeson (FromJSON, ToJSON)" | hasSnapshot a]+      ++ ["import Data.Proxy (Proxy (..))" | not (null ((.regs) a))]+      ++ ["import Data.Text (Text)" | AggregateText `elem` aggregateTypes a]+      ++ [ "import GHC.Generics (Generic)",+           "import Keiki.Core (RegFile (..))"+         ]+      ++ ["import Keiki.Shape (CanonicalStateShape, CanonicalTypeName)" | hasSnapshot a]+      ++ generatedNominalDomainImports a+      ++ map ("import " <>) (domainStaticImports a)+      ++ T.lines (renderPlannedImports importPlan)+      ++ [ "import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)",+           "",+           sectionsOf+             [ [emitVertex a],+               map (emitRecord importPlan a) ((.commands) a),+               [emitSum ((.name) a <> "Command") ((.commands) a)],+               map (emitRecord importPlan a) ((.events) a),+               [emitSum ((.name) a <> "Event") ((.events) a)],+               [emitRegsType importPlan a, emitInitialRegs importPlan a],+               [ "$(deriveAggregateCtorsAll ''" <> (.name) a <> "Command ''" <> (.name) a <> "Regs)",+                 "",+                 "$(deriveWireCtorsAll ''" <> (.name) a <> "Event)"+               ]+             ]+         ]+  where+    importPlan = domainImportPlan a++domainNeedsDuplicateRecordFields :: Agg -> Bool+domainNeedsDuplicateRecordFields aggregate = hasDuplicateNames selectorNames+  where+    commandSelectors = concatMap (map ((.selector) . fst) . (.fields)) ((.commands) aggregate)+    eventSelectors = concatMap (map ((.selector) . fst) . (.fields)) ((.events) aggregate)+    registerSelectors = map (.name) ((.regs) aggregate)+    -- deriveWireCtorsAll creates one event TermFields record that repeats each+    -- payload selector, so every field-bearing event contributes twice.+    selectorNames = commandSelectors <> eventSelectors <> eventSelectors <> registerSelectors++hasDuplicateNames :: [Text] -> Bool+hasDuplicateNames names = length names /= Set.size (Set.fromList names)++hasSnapshot :: Agg -> Bool+hasSnapshot = maybe False (const True) . (.snapshot)++emitVertex :: Agg -> Text+emitVertex a =+  nl $+    [ "data " <> (.vertexType) a <> " = " <> T.intercalate " | " (map (vertexCtor a . (.name)) ((.states) a)),+      "  deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)"+    ]+      ++ ["  deriving anyclass (ToJSON, FromJSON)" | hasSnapshot a]+      ++ [ line+         | hasSnapshot a,+           line <-+             [ "instance CanonicalStateShape " <> (.vertexType) a,+               "instance CanonicalTypeName " <> (.vertexType) a+             ]+         ]++emitRecord :: HaskellImportPlan -> Agg -> ResolvedCtor -> Text+emitRecord importPlan a rc =+  nl $+    [ "data " <> (.name) rc <> "Data = " <> (.name) rc <> "Data"+    ]+      ++ recordFields [((.selector) identity, renderDomainType importPlan a valueType) | (identity, valueType) <- (.fields) rc]+      ++ ["  deriving stock (Generic, Eq, Show)"]++recordFields :: [(Text, Text)] -> [Text]+recordFields [] =+  ["  {"]+    <> ["  }"]+recordFields fs =+  [ lead i <> n <> " :: !" <> ty+  | (i, (n, ty)) <- zip [(0 :: Int) ..] fs+  ]+    ++ ["  }"]+  where+    lead 0 = "  { "+    lead _ = "  , "++emitSum :: Text -> [ResolvedCtor] -> Text+emitSum tyName ctors =+  nl $+    [firstLine] ++ restLines ++ ["  deriving stock (Generic, Eq, Show)"]+  where+    arm rc = rc' rc+    rc' rc = (.name) rc <> " !" <> (.name) rc <> "Data"+    (firstLine, restLines) = case ctors of+      [] -> ("data " <> tyName, [])+      (c : cs) ->+        ( "data " <> tyName <> " = " <> arm c,+          ["  | " <> arm c2 | c2 <- cs]+        )++emitRegsType :: HaskellImportPlan -> Agg -> Text+emitRegsType importPlan a =+  nl $+    ["type " <> (.name) a <> "Regs ="]+      ++ regListLines importPlan a ((.regs) a)++regListLines :: HaskellImportPlan -> Agg -> [ResolvedRegister] -> [Text]+regListLines _ _ [] = ["  '[]"]+regListLines importPlan a rs =+  [ lead i <> "'(" <> tshow ((.name) r) <> ", " <> renderDomainType importPlan a ((.valueType) r) <> ")"+  | (i, r) <- zip [(0 :: Int) ..] rs+  ]+    ++ ["   ]"]+  where+    lead 0 = "  '[ "+    lead _ = "   , "++emitInitialRegs :: HaskellImportPlan -> Agg -> Text+emitInitialRegs importPlan a =+  nl $+    [ "initial" <> (.name) a <> "Regs :: RegFile " <> (.name) a <> "Regs",+      "initial" <> (.name) a <> "Regs ="+    ]+      ++ chain ((.regs) a)+  where+    chain [] = ["  RNil"]+    chain rs =+      [ "  RCons (Proxy @" <> tshow ((.name) r) <> ") " <> regInitialValue importPlan a r <> " $"+      | r <- init rs+      ]+        ++ ["  RCons (Proxy @" <> tshow ((.name) lastR) <> ") " <> regInitialValue importPlan a lastR <> " RNil"]+      where+        lastR = last rs++-- | The Haskell initial value for a register, by the category of its type.+regInitialValue :: HaskellImportPlan -> Agg -> ResolvedRegister -> Text+regInitialValue importPlan aggregate register = case (.initial) register of+  InitialId name -> case find ((== name) . (.name)) ((.generatedNominals) aggregate) >>= generatedIdSampleHaskell aggregate of+    Just value -> value+    Nothing -> renderRegisterInitial ((.initial) register)+  InitialNominal _ value -> renderReferenceOrDie importPlan (qualifiedValueReference value)+  InitialMapped _ value -> renderReferenceOrDie importPlan (qualifiedValueReference value)+  _ -> renderRegisterInitial ((.initial) register)++domainImportPlan :: Agg -> HaskellImportPlan+domainImportPlan aggregate =+  planImportsOrDie+    ((.genPrefix) aggregate <> ".Domain")+    localDeclarations+    (Set.unions (map aggregateSourceReferences (domainAggregateSources aggregate)) <> initialReferences)+  where+    localDeclarations =+      Set.fromList+        ( [ (.vertexType) aggregate,+            (.name) aggregate <> "Command",+            (.name) aggregate <> "Event",+            (.name) aggregate <> "Regs"+          ]+            <> [(.name) constructor <> "Data" | constructor <- (.commands) aggregate <> (.events) aggregate]+            <> map (.name) ((.generatedNominals) aggregate)+        )+    initialReferences =+      Set.fromList+        ( [ qualifiedValueReference initialValue+          | declaration <- mappedUses aggregate,+            initialValue <- maybeToListText (mappedInitial declaration)+          ]+            <> [ qualifiedValueReference initialValue+               | resolvedType <- aggregateTypes aggregate,+                 AggregateNominal nominal <- [resolvedType],+                 ConsumerNominal binding <- [(.ownership) nominal],+                 initialValue <- maybeToListText ((.initial) binding)+               ]+        )++generatedNominalDomainImports :: Agg -> [Text]+generatedNominalDomainImports aggregate+  | null nominals = []+  | otherwise =+      [ "import "+          <> generatedNominalModule ((.context) aggregate)+          <> " ("+          <> T.intercalate ", " (concatMap importsFor nominals)+          <> ")"+      ]+  where+    nominals = stableNominals ((.generatedNominals) aggregate)+    importsFor nominal = case (.representation) nominal of+      IdRepresentation prefix+        | Just _ <- idDomainContractFor ((.languageContract) aggregate) prefix ->+            (.name) nominal+              : ["parse" <> (.name) nominal | needsParser nominal]+      _ -> [(.name) nominal <> " (..)"]+    needsParser nominal =+      any+        (\register -> (.valueType) register == AggregateNominal nominal && case (.initial) register of InitialId {} -> True; _ -> False)+        ((.regs) aggregate)++domainStaticImports :: Agg -> [Text]+domainStaticImports aggregate =+  Set.toAscList (Set.delete timeTypeImport sourceImports <> Set.fromList timeImports)+  where+    sourceImports = Set.unions (map aggregateSourceStaticImports (domainAggregateSources aggregate))+    timeTypeImport = "Data.Time.Clock (UTCTime)"+    usesTimeType = AggregateTime `elem` aggregateTypes aggregate+    usesTimeLiteral = any (\register -> case (.initial) register of InitialTime {} -> True; _ -> False) ((.regs) aggregate)+    timeImports+      | usesTimeLiteral =+          [ "Data.Time.Calendar (fromGregorian)",+            "Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)"+          ]+      | usesTimeType = [timeTypeImport]+      | otherwise = []++domainAggregateSources :: Agg -> [AggregateHaskellSource]+domainAggregateSources aggregate =+  map (aggregateConsumerHaskellSource ((.symbols) aggregate)) (aggregateTypes aggregate)++aggregateTypes :: Agg -> [ResolvedAggregateType]+aggregateTypes aggregate =+  map snd (concatMap (.fields) ((.commands) aggregate <> (.events) aggregate)) <> map (.valueType) ((.regs) aggregate)++mappedUses :: Agg -> [ResolvedMappedDecl]+mappedUses a =+  [ declaration+  | resolvedType <-+      map snd (concatMap (.fields) ((.commands) a <> (.events) a))+        <> map (.valueType) ((.regs) a),+    declaration <- maybeToListText (mappedDeclFor a resolvedType)+  ]++mappedDeclFor :: Agg -> ResolvedAggregateType -> Maybe ResolvedMappedDecl+mappedDeclFor a resolvedType = do+  key <- case resolvedType of+    AggregateMapped mappedKey -> Just mappedKey+    _ -> Nothing+  graph <- (.typeGraph) a+  Map.lookup key ((.declarations) graph)++mappedInitial :: ResolvedMappedDecl -> Maybe QualifiedValueName+mappedInitial (ResolvedStructural declaration _) = (.initial) declaration+mappedInitial (ResolvedOpaque declaration) = (.initial) declaration++renderDomainType :: HaskellImportPlan -> Agg -> ResolvedAggregateType -> Text+renderDomainType importPlan aggregate resolvedType =+  either+    (error . ("validated aggregate Haskell reference failed: " <>) . show)+    id+    (renderAggregateHaskellSource importPlan (aggregateConsumerHaskellSource ((.symbols) aggregate) resolvedType))++maybeToListText :: Maybe value -> [value]+maybeToListText = maybe [] pure++--------------------------------------------------------------------------------+-- Codec module+--------------------------------------------------------------------------------++emitCodec :: Agg -> Text+emitCodec a =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedRecordDot | codecUsesRecordDot a]+      ++ [ generatedBanner,+           "module " <> (.genPrefix) a <> ".Codec (",+           "    " <> lowerFirst ((.name) a) <> "Codec,",+           "    parse" <> (.name) a <> "Event,",+           "    encode" <> (.name) a <> "Event,"+         ]+      ++ concatMap mappedExports (codecMappedDeclarations a)+      ++ [ ") where",+           "",+           "import " <> (.genPrefix) a <> ".Domain"+         ]+      ++ generatedNominalCodecImports (aggregateCheckedService a) ((.context) a) (codecGeneratedNominals a)+      ++ ["import Control.Monad (unless)" | codecUsesUnknownFieldRejection a]+      ++ [codecAesonImport a]+      ++ ["import Data.Aeson.Key qualified as Key" | codecUsesKeyMap a]+      ++ ["import Data.Aeson.KeyMap qualified as KeyMap" | codecUsesKeyMap a]+      ++ [ "import Data.Aeson.Types (" <> T.intercalate ", " (codecAesonTypesImports a) <> ")",+           "import Data.List.NonEmpty (NonEmpty (..))",+           "import Data.List.NonEmpty qualified as NonEmpty"+         ]+      ++ ( if codecUsesMap a+             then ["import Data.Map.Strict (Map)", "import Data.Map.Strict qualified as Map"]+             else []+         )+      ++ [ "import Data.Text (Text)",+           "import qualified Data.Text as T"+         ]+      ++ ["import Data.KindID qualified as KindID" | hasConsumerNominalIdCodec a]+      ++ ["import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)" | hasEnforcedConsumerNominalIdCodec a]+      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)" | hasConsumerNominalCodec a]+      ++ ["import Keiro.Codec.Structural (bindingFromShape, bindingToShape)" | hasStructuralMappedCodec a]+      ++ [ "import Keiro.Codec (Codec (..), EventType (..))",+           upcasterImport a+         ]+      ++ [nl (map ("import " <>) (codecMappedImports a)) | hasMappedCodec a]+      ++ [nl (map ("import " <>) (codecNominalImports a)) | hasConsumerNominalCodec a]+      ++ T.lines (renderPlannedImports importPlan)+      ++ [ "",+           emitEnumParsers a,+           emitConsumerNominalParsers importPlan a+         ]+      ++ [emitMappedCodecs importPlan a | hasMappedCodec a]+      ++ [ "",+           emitEventTypes a,+           "",+           emitCodecValue a,+           "",+           emitEncode importPlan a,+           "",+           emitDecode importPlan a,+           "",+           "mapLeftText :: Either String b -> Either Text b",+           "mapLeftText = either (Left . T.pack) Right",+           "",+           "renderExpectedEventTypes :: NonEmpty EventType -> String",+           "renderExpectedEventTypes =",+           "  T.unpack",+           "    . T.intercalate \", \"",+           "    . map (\\(EventType eventTypeName) -> eventTypeName)",+           "    . NonEmpty.toList"+         ]+      ++ ( if codecUsesOptionalFieldHelper a+             then+               [ "",+                 "parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue",+                 "parseOptionalField onMissing parseItem objectValue key =",+                 "  case KeyMap.lookup key objectValue of",+                 "    Nothing -> onMissing",+                 "    Just _ -> explicitParseField parseItem objectValue key"+               ]+             else []+         )+      ++ ( if codecUsesUnknownFieldRejection a+             then+               [ "",+                 "rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()",+                 "rejectUnknownFields label allowed objectValue =",+                 "  unless (null extras) (fail (label <> \" contains unknown fields: \" <> show extras))",+                 "  where",+                 "    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))"+               ]+             else []+         )+  where+    importPlan = codecImportPlan a+    mappedExports (ResolvedStructural declaration _) =+      [ "    encode" <> (.name) declaration <> "Mapped,",+        "    decode" <> (.name) declaration <> "Mapped,"+      ]+    mappedExports ResolvedOpaque {} = []++codecUsesRecordDot :: Agg -> Bool+codecUsesRecordDot = any (not . null . (.fields)) . (.events)++hasMappedCodec :: Agg -> Bool+hasMappedCodec = not . null . codecMappedDeclarations++hasStructuralMappedCodec :: Agg -> Bool+hasStructuralMappedCodec = any isStructural . codecMappedDeclarations+  where+    isStructural ResolvedStructural {} = True+    isStructural ResolvedOpaque {} = False++codecAesonImport :: Agg -> Text+codecAesonImport aggregate =+  "import Data.Aeson (" <> T.intercalate ", " imports <> ")"+  where+    imports =+      [if codecUsesValueConstructors aggregate then "Value (..)" else "Value"]+        <> ["object" | codecUsesObject aggregate]+        <> ["parseJSON" | codecUsesParseJSON aggregate]+        <> ["toJSON" | codecUsesToJSON aggregate]+        <> ["withObject"]+        <> ["withText" | codecUsesWithText aggregate]+        <> ["(.:)" | codecUsesDotColon aggregate]+        <> ["(.=)" | codecUsesObject aggregate]++codecUsesObject :: Agg -> Bool+codecUsesObject aggregate =+  not (null ((.events) aggregate)) || any structuralUsesObject (codecMappedDeclarations aggregate)+  where+    structuralUsesObject (ResolvedStructural _ shape) = case shape of REnum {} -> False; _ -> True+    structuralUsesObject ResolvedOpaque {} = False++codecAesonTypesImports :: Agg -> [Text]+codecAesonTypesImports aggregate =+  ["Parser" | codecUsesParserType aggregate]+    <> ["explicitParseField" | codecUsesExplicitParseField aggregate]+    <> ["parseEither"]++codecUsesParserType :: Agg -> Bool+codecUsesParserType aggregate =+  codecUsesWithText aggregate || hasStructuralMappedCodec aggregate++codecUsesExplicitParseField :: Agg -> Bool+codecUsesExplicitParseField aggregate =+  codecUsesWithText aggregate || any structuralUsesExplicitParseField (codecMappedDeclarations aggregate)+  where+    structuralUsesExplicitParseField (ResolvedStructural _ shape) = case shape of+      RRecord _ _ fields -> not (null fields)+      REnum {} -> False+      RUnion {} -> True+    structuralUsesExplicitParseField ResolvedOpaque {} = False++codecUsesWithText :: Agg -> Bool+codecUsesWithText aggregate =+  any nominalUsesWithText (codecGeneratedNominals aggregate <> codecConsumerNominals aggregate)+    || any mappedUsesWithText (codecMappedDeclarations aggregate)+  where+    nominalUsesWithText nominal = case (.representation) nominal of+      EnumRepresentation {} -> True+      IdRepresentation {} -> case (.ownership) nominal of ConsumerNominal {} -> True; GeneratedNominal -> False+      ScalarRepresentation {} -> False+    mappedUsesWithText (ResolvedStructural _ shape) = case shape of+      REnum {} -> True+      RUnion {} -> True+      RRecord {} -> False+    mappedUsesWithText ResolvedOpaque {} = False++codecUsesDotColon :: Agg -> Bool+codecUsesDotColon aggregate = any fieldUsesDotColon (concatMap (.fields) ((.events) aggregate))+  where+    fieldUsesDotColon (_, resolvedType) = case resolvedType of+      AggregateNominal nominal -> case ((.ownership) nominal, (.representation) nominal) of+        (GeneratedNominal, EnumRepresentation {}) -> False+        (ConsumerNominal {}, IdRepresentation {}) -> False+        (ConsumerNominal {}, EnumRepresentation {}) -> False+        _ -> True+      _ -> case fieldCat aggregate resolvedType of+        MappedStructuralCat {} -> False+        _ -> True++codecUsesKeyMap :: Agg -> Bool+codecUsesKeyMap aggregate = codecUsesOptionalFieldHelper aggregate || codecUsesUnknownFieldRejection aggregate++codecUsesUnknownFieldRejection :: Agg -> Bool+codecUsesUnknownFieldRejection = any declarationRejectsUnknown . codecMappedDeclarations+  where+    declarationRejectsUnknown (ResolvedStructural _ shape) = case shape of+      RRecord _ RejectUnknown _ -> True+      RUnion encoding _ -> (.unknownFields) encoding == RejectUnknown+      _ -> False+    declarationRejectsUnknown ResolvedOpaque {} = False++codecUsesMap :: Agg -> Bool+codecUsesMap = any declarationUsesMap . codecMappedDeclarations+  where+    declarationUsesMap (ResolvedStructural _ shape) = any typeUsesMap (shapeTypeExpressions shape)+    declarationUsesMap ResolvedOpaque {} = False++codecUsesParseJSON :: Agg -> Bool+codecUsesParseJSON aggregate = any (declarationUsesAesonConversion aggregate) (codecMappedDeclarations aggregate)++codecUsesToJSON :: Agg -> Bool+codecUsesToJSON aggregate =+  any directOpaqueField (concatMap (.fields) ((.events) aggregate))+    || any (declarationUsesAesonConversion aggregate) (codecMappedDeclarations aggregate)+  where+    directOpaqueField (_, resolvedType) = case fieldCat aggregate resolvedType of MappedOpaqueCat {} -> True; _ -> False++codecUsesValueConstructors :: Agg -> Bool+codecUsesValueConstructors = any declarationUsesConstructors . codecMappedDeclarations+  where+    declarationUsesConstructors (ResolvedStructural _ shape) =+      case shape of REnum {} -> True; _ -> any typeUsesOptional (shapeTypeExpressions shape)+    declarationUsesConstructors ResolvedOpaque {} = False++declarationUsesAesonConversion :: Agg -> ResolvedMappedDecl -> Bool+declarationUsesAesonConversion aggregate (ResolvedStructural _ shape) =+  any (typeUsesAesonConversion aggregate) (shapeTypeExpressions shape)+declarationUsesAesonConversion _ ResolvedOpaque {} = False++shapeTypeExpressions :: ResolvedMappedShape -> [ResolvedTypeExpr]+shapeTypeExpressions = \case+  RRecord _ _ fields -> map (.valueType) fields+  REnum {} -> []+  RUnion _ arms -> mapMaybe (.payload) arms++typeUsesMap :: ResolvedTypeExpr -> Bool+typeUsesMap =+  foldTypeExpr+    TypeExprAlgebra+      { onText = False,+        onInt = False,+        onInteger = False,+        onBool = False,+        onNatural = False,+        onTime = False,+        onJson = False,+        onOptional = id,+        onList = id,+        onMap = const True,+        onRef = const False+      }++typeUsesOptional :: ResolvedTypeExpr -> Bool+typeUsesOptional =+  foldTypeExpr+    TypeExprAlgebra+      { onText = False,+        onInt = False,+        onInteger = False,+        onBool = False,+        onNatural = False,+        onTime = False,+        onJson = False,+        onOptional = const True,+        onList = id,+        onMap = id,+        onRef = const False+      }++typeUsesAesonConversion :: Agg -> ResolvedTypeExpr -> Bool+typeUsesAesonConversion aggregate =+  foldTypeExpr+    TypeExprAlgebra+      { onText = True,+        onInt = True,+        onInteger = True,+        onBool = True,+        onNatural = True,+        onTime = True,+        onJson = False,+        onOptional = id,+        onList = const True,+        onMap = const True,+        onRef = \key -> case (.typeGraph) aggregate >>= \graph -> Map.lookup key ((.declarations) graph) of+          Just ResolvedOpaque {} -> True+          _ -> False+      }++codecUsesOptionalFieldHelper :: Agg -> Bool+codecUsesOptionalFieldHelper aggregate =+  any structuralHasOptionalField (codecMappedDeclarations aggregate)+  where+    structuralHasOptionalField (ResolvedStructural _ (RRecord _ _ fields)) =+      any ((== POptional) . (.presence)) fields+    structuralHasOptionalField (ResolvedStructural _ _) = False+    structuralHasOptionalField ResolvedOpaque {} = False++hasConsumerNominalCodec :: Agg -> Bool+hasConsumerNominalCodec = not . null . codecConsumerNominals++hasConsumerNominalIdCodec :: Agg -> Bool+hasConsumerNominalIdCodec aggregate =+  any+    (\nominal -> case (.representation) nominal of IdRepresentation {} -> True; _ -> False)+    (codecConsumerNominals aggregate)++hasEnforcedConsumerNominalIdCodec :: Agg -> Bool+hasEnforcedConsumerNominalIdCodec aggregate =+  any+    ( \nominal -> case (.representation) nominal of+        IdRepresentation prefix -> isJust (idDomainContractFor ((.languageContract) aggregate) prefix)+        _ -> False+    )+    (codecConsumerNominals aggregate)++emitEnumParsers :: Agg -> Text+emitEnumParsers a =+  sectionsOf+    [ [emitEnumParser nominal | nominal <- codecGeneratedNominals a, EnumRepresentation {} <- [(.representation) nominal]]+    ]++emitEnumParser :: ResolvedNominalType -> Text+emitEnumParser nominal = case (.representation) nominal of+  EnumRepresentation constructors ->+    nl $+      [ "parse" <> name <> " :: Text -> Parser " <> name,+        "parse" <> name <> " = \\case"+      ]+        ++ ["  " <> tshow wire <> " -> pure " <> constructor | (constructor, wire) <- NE.toList constructors]+        ++ ["  tag -> " <> renderUnknownFailure name "tag" (map snd (NE.toList constructors))]+  _ -> error "non-enum reached generated enum parser emission"+  where+    name = (.name) nominal++emitConsumerNominalParsers :: HaskellImportPlan -> Agg -> Text+emitConsumerNominalParsers importPlan aggregate = sectionsOf [map emitParser (codecConsumerNominals aggregate)]+  where+    emitParser nominal = case ((.representation) nominal, (.ownership) nominal) of+      (IdRepresentation prefix, ConsumerNominal binding) ->+        nl $+          [ parserName nominal <> " :: Text -> Parser " <> renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding))+          ]+            <> parserBody nominal prefix binding+      (EnumRepresentation constructors, ConsumerNominal binding) ->+        nl $+          [ parserName nominal <> " :: Text -> Parser " <> renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) binding)),+            parserName nominal <> " = \\case"+          ]+            <> [ "  "+                   <> tshow wire+                   <> " -> pure (nominalFromRepresentation "+                   <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+                   <> " "+                   <> renderReferenceOrDie importPlan (nominalRepresentationConstructorReference ((.context) aggregate) nominal constructor)+                   <> ")"+               | (constructor, wire) <- NE.toList constructors+               ]+            <> ["  tag -> " <> renderUnknownFailure ((.name) nominal <> " wire value") "tag" (map snd (NE.toList constructors))]+      _ -> ""+    parserName nominal = "parse" <> (.name) nominal <> "Nominal"+    parserBody nominal prefix binding = case idDomainContractFor ((.languageContract) aggregate) prefix of+      Nothing ->+        [ parserName nominal <> " input = case KindID.parseText @" <> tshow prefix <> " input of",+          "  Left reason -> fail (show reason)",+          "  Right representation -> pure (nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding)) <> " representation)"+        ]+      Just _ ->+        [ parserName nominal <> " input = case validateIdDomainText (typeIdV7Domain " <> tshow prefix <> ") input of",+          "  Left reason -> fail (show reason)",+          "  Right () -> case KindID.parseText @" <> tshow prefix <> " input of",+          "    Left reason -> fail (show reason)",+          "    Right representation -> pure (nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding)) <> " representation)"+        ]++emitCodecValue :: Agg -> Text+emitCodecValue a =+  nl $+    [ lowerFirst ((.name) a) <> "Codec :: Codec " <> (.name) a <> "Event",+      lowerFirst ((.name) a) <> "Codec =",+      "  Codec",+      "    { eventTypes = " <> eventTypesName a,+      "    , eventType = \\case"+    ]+      ++ ["        " <> (.name) e <> "{} -> EventType " <> tshow ((.name) e) | e <- (.events) a]+      ++ [ "    , schemaVersion = " <> tshow' (maxEventVersion a),+           "    , encode = encode" <> (.name) a <> "Event",+           "    , decode = parse" <> (.name) a <> "Event",+           "    , upcasters = " <> upcastersExpr a,+           "    }"+         ]+      ++ upcasterRungDecls a++emitEventTypes :: Agg -> Text+emitEventTypes aggregate =+  nl+    [ eventTypesName aggregate <> " :: NonEmpty EventType",+      eventTypesName aggregate <> " = " <> eventTypesExpr+    ]+  where+    eventTypesExpr = case map (.name) ((.events) aggregate) of+      [] -> "error \"no events\""+      event : rest -> "EventType " <> tshow event <> " :| [" <> T.intercalate ", " (map (("EventType " <>) . tshow) rest) <> "]"++eventTypesName :: Agg -> Text+eventTypesName aggregate = lowerFirst ((.name) aggregate) <> "EventTypes"++-- | The codec's @schemaVersion@: the maximum declared event version (EP-2).+maxEventVersion :: Agg -> Int+maxEventVersion a = maximum (1 : map (.version) ((.events) a))++-- | One @(sourceVersion, upcasterName)@ entry per event that declares an+-- @upcast from@. The upcaster name is per-event (e.g. @upcastFooV1@) and its+-- body is a hole in the hand-owned Holes module.+upcasterEntries :: Agg -> [(Int, Text, Text)]+upcasterEntries a =+  [ (m, (.name) e, "upcast" <> (.name) e <> "V" <> tshow' m)+  | e <- (.events) a,+    Just m <- [(.upcastFrom) e]+  ]++upcastersExpr :: Agg -> Text+upcastersExpr a =+  "[" <> T.intercalate ", " ["(" <> tshow' m <> ", upcastRungV" <> tshow' m <> ")" | (m, _) <- upcasterRungs a] <> "]"++-- | Group event-specific holes into one migration rung per aggregate-global+-- source version.  Event metadata stamps every kind with the aggregate's+-- schema version, so a rung must explicitly pass foreign event kinds through.+upcasterRungs :: Agg -> [(Int, [(Text, Text)])]+upcasterRungs a =+  [ (source, [(eventName, fn) | (_, eventName, fn) <- entries])+  | entries@((source, _, _) : _) <- groupBy sameSource (sortOn firstSource (upcasterEntries a))+  ]+  where+    firstSource (source, _, _) = source+    sameSource (source, _, _) (otherSource, _, _) = source == otherSource++upcasterRungDecls :: Agg -> [Text]+upcasterRungDecls a = concatMap rung (upcasterRungs a)+  where+    rung (source, entries) =+      [ "",+        "upcastRungV" <> tshow' source <> " :: EventType -> Value -> Either Text Value"+      ]+        ++ [ "upcastRungV" <> tshow' source <> " (EventType " <> tshow eventName <> ") value = " <> fn <> " value"+           | (eventName, fn) <- entries+           ]+        ++ [ "-- Kinds whose shape did not change at this rung pass through unchanged; their",+             "-- stamped version is aggregate-global, not their own shape history.",+             "upcastRungV" <> tshow' source <> " _ value = Right value"+           ]++-- | When the codec references upcasters, it imports their (hole) definitions+-- from the hand-owned Holes module.+upcasterImport :: Agg -> Text+upcasterImport a = case upcasterEntries a of+  [] -> ""+  es -> "import " <> (.holePrefix) a <> ".Holes (" <> T.intercalate ", " [fn | (_, _, fn) <- es] <> ")"++emitEncode :: HaskellImportPlan -> Agg -> Text+emitEncode importPlan a =+  nl $+    [ "encode" <> (.name) a <> "Event :: " <> (.name) a <> "Event -> Value",+      "encode" <> (.name) a <> "Event = \\case"+    ]+      ++ concatMap encodeArm ((.events) a)+  where+    encodeArm e =+      [ "  " <> (.name) e <> " payload ->",+        "    object"+      ]+        ++ [ lead i <> kv+           | (i, kv) <- zip [(0 :: Int) ..] (("\"kind\" .= (" <> tshow ((.name) e) <> " :: Text)") : map encodeField ((.fields) e))+           ]+        ++ ["      ]"]+    lead 0 = "      [ "+    lead _ = "      , "+    encodeField (identity, ty) =+      tshow ((.wireKey) identity)+        <> " .= "+        <> encodeFieldValue ((.selector) identity) ty+    encodeFieldValue selector ty = case ty of+      AggregateNominal nominal -> encodeNominalValue nominal ("payload." <> selector)+      _ -> case fieldCat a ty of+        MappedStructuralCat {} -> encodeMapped ty ("payload." <> selector)+        MappedOpaqueCat {} -> encodeMapped ty ("payload." <> selector)+        _ -> "payload." <> selector+    encodeMapped (AggregateMapped key) value = case (.typeGraph) a of+      Nothing -> error "mapped aggregate field has no resolved type graph"+      Just graph ->+        renderMappedEncode graph ConsumerValueBoundary (mappedCodecPlanOrDie graph (RRef key)) value+    encodeMapped _ _ = error "non-mapped aggregate type reached mapped codec lowering"+    encodeNominalValue nominal value = case (.ownership) nominal of+      GeneratedNominal -> case (.representation) nominal of+        IdRepresentation {} -> lowerFirst ((.name) nominal) <> "Text " <> value+        EnumRepresentation {} -> lowerFirst ((.name) nominal) <> "Text " <> value+        ScalarRepresentation {} -> value+      ConsumerNominal binding -> case (.representation) nominal of+        IdRepresentation {} -> "KindID.toText (nominalToRepresentation " <> bindingName binding <> " " <> value <> ")"+        EnumRepresentation {} ->+          renderReferenceOrDie importPlan (nominalRepresentationEncoderReference ((.context) a) nominal)+            <> " (nominalToRepresentation "+            <> bindingName binding+            <> " "+            <> value+            <> ")"+        ScalarRepresentation {} -> "nominalToRepresentation " <> bindingName binding <> " " <> value+    bindingName = renderReferenceOrDie importPlan . qualifiedValueReference . (.binding)++emitDecode :: HaskellImportPlan -> Agg -> Text+emitDecode importPlan a =+  nl $+    [ "parse" <> (.name) a <> "Event :: EventType -> Value -> Either Text " <> (.name) a <> "Event",+      "parse" <> (.name) a <> "Event (EventType tag) = mapLeftText . parseEither (withObject " <> tshow ((.name) a <> "Event") <> " go)",+      "  where",+      "    go o = do",+      "      case tag of"+    ]+      ++ concatMap decodeArm ((.events) a)+      ++ ["        _ -> " <> renderUnknownEventTypeFailure a "tag"]+  where+    decodeArm e =+      ["        " <> tshow ((.name) e) <> " ->"]+        ++ case (.fields) e of+          [] -> ["          pure (" <> (.name) e <> " " <> (.name) e <> "Data)"]+          fields ->+            [ "          " <> (.name) e,+              "            <$> ( " <> (.name) e <> "Data"+            ]+              ++ [ (if index == 0 then "                    <$> " else "                    <*> ") <> decodeField field+                 | (index, field) <- zip [(0 :: Int) ..] fields+                 ]+              ++ ["                )"]+    decodeField (identity, ty) = case ty of+      AggregateNominal nominal -> decodeNominalField ((.wireKey) identity) nominal+      _ -> case fieldCat a ty of+        MappedStructuralCat {} -> decodeMapped ty ((.wireKey) identity)+        MappedOpaqueCat {} -> "o .: " <> tshow ((.wireKey) identity)+        _ -> "o .: " <> tshow ((.wireKey) identity)+    decodeMapped (AggregateMapped mappedKey) key = case (.typeGraph) a of+      Nothing -> error "mapped aggregate field has no resolved type graph"+      Just graph ->+        "explicitParseField "+          <> renderMappedParse graph ConsumerValueBoundary (mappedCodecPlanOrDie graph (RRef mappedKey))+          <> " o "+          <> tshow key+    decodeMapped _ _ = error "non-mapped aggregate type reached mapped codec lowering"+    decodeNominalField name nominal = case (.ownership) nominal of+      GeneratedNominal -> case (.representation) nominal of+        IdRepresentation prefix -> case idDomainContractFor ((.languageContract) a) prefix of+          Nothing -> "(" <> (.name) nominal <> " <$> o .: " <> tshow name <> ")"+          Just _ -> "(" <> legacyNominalConstructorName nominal <> " <$> o .: " <> tshow name <> ")"+        EnumRepresentation {} ->+          "explicitParseField (withText "+            <> tshow ((.name) nominal)+            <> " parse"+            <> (.name) nominal+            <> ") o "+            <> tshow name+        ScalarRepresentation {} -> "o .: " <> tshow name+      ConsumerNominal binding -> case (.representation) nominal of+        IdRepresentation {} -> consumerNominalFieldParser name nominal+        EnumRepresentation {} -> consumerNominalFieldParser name nominal+        ScalarRepresentation {} -> "(nominalFromRepresentation " <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding)) <> " <$> o .: " <> tshow name <> ")"+    consumerNominalFieldParser name nominal =+      "explicitParseField (withText "+        <> tshow ((.name) nominal)+        <> " parse"+        <> (.name) nominal+        <> "Nominal) o "+        <> tshow name++codecConsumerNominals :: Agg -> [ResolvedNominalType]+codecConsumerNominals aggregate =+  Map.elems . Map.fromList $+    [ ((.name) nominal, nominal)+    | event <- (.events) aggregate,+      (_, AggregateNominal nominal) <- (.fields) event,+      ConsumerNominal {} <- [(.ownership) nominal]+    ]++codecGeneratedNominals :: Agg -> [ResolvedNominalType]+codecGeneratedNominals aggregate =+  generatedNominalsInTypes+    [ resolvedType+    | event <- (.events) aggregate,+      (_, resolvedType) <- (.fields) event+    ]++codecImportPlan :: Agg -> HaskellImportPlan+codecImportPlan aggregate =+  planImportsOrDie+    ((.genPrefix) aggregate <> ".Codec")+    (Set.fromList [(.name) aggregate <> "Event"])+    (Set.fromList (nominalReferences <> mappedReferences <> nominalRepresentationReferences <> shapeReferences))+  where+    nominalReferences =+      [ reference+      | nominal <- codecConsumerNominals aggregate,+        ConsumerNominal binding <- [(.ownership) nominal],+        reference <- qualifiedValueReference ((.binding) binding) : nominalParserTypeReferences nominal binding+      ]+    nominalParserTypeReferences nominal binding = case (.representation) nominal of+      IdRepresentation {} -> [haskellTypeReference ((.haskell) binding)]+      EnumRepresentation {} -> [haskellTypeReference ((.haskell) binding)]+      ScalarRepresentation {} -> []+    mappedReferences =+      [ reference+      | ResolvedStructural declaration _ <- codecMappedDeclarations aggregate,+        reference <-+          [ haskellTypeReference ((.haskell) declaration),+            qualifiedValueReference ((.binding) declaration)+          ]+      ]+    nominalRepresentationReferences =+      [ reference+      | nominal <- codecConsumerNominals aggregate,+        EnumRepresentation constructors <- [(.representation) nominal],+        reference <-+          nominalRepresentationEncoderReference ((.context) aggregate) nominal+            : [ nominalRepresentationConstructorReference ((.context) aggregate) nominal constructor+              | (constructor, _) <- NE.toList constructors+              ]+      ]+    shapeReferences =+      [ reference+      | ResolvedStructural declaration shape <- codecMappedDeclarations aggregate,+        reference <- structuralShapeReferences ((.context) aggregate) declaration shape+      ]++codecNominalImports :: Agg -> [Text]+codecNominalImports _ = []++codecMappedImports :: Agg -> [Text]+codecMappedImports a = case (.typeGraph) a of+  Nothing -> []+  Just graph ->+    sort . nub $+      [ (.moduleName) ((.haskell) declaration) <> " ()"+      | ResolvedOpaque declaration <- codecMappedDeclarations a+      ]+        <> [ (.moduleName) ((.haskell) declaration) <> " ()"+           | ResolvedStructural _ shape <- codecMappedDeclarations a,+             key <- directShapeRefs shape,+             Just (ResolvedOpaque declaration) <- [Map.lookup key ((.declarations) graph)]+           ]++codecMappedDeclarations :: Agg -> [ResolvedMappedDecl]+codecMappedDeclarations a = case (.typeGraph) a of+  Nothing -> []+  Just graph ->+    mapMaybe (\key -> Map.lookup key ((.declarations) graph)) (sort (Map.keys selected))+    where+      roots =+        [ key+        | event <- (.events) a,+          (_, AggregateMapped key) <- (.fields) event,+          Map.member key ((.declarations) graph)+        ]+      selected =+        Map.fromList+          [ (key, ())+          | root <- roots,+            key <- root : maybe [] (Map.keys . Map.fromSet (const ())) (Map.lookup root ((.reachability) graph))+          ]++directShapeRefs :: ResolvedMappedShape -> [MappedKey]+directShapeRefs =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \_ _ fields -> concatMap (exprRefs . (.valueType)) fields,+        onEnum = const [],+        onUnion = \_ arms -> concatMap (maybe [] exprRefs . (.payload)) arms+      }++exprRefs :: ResolvedTypeExpr -> [MappedKey]+exprRefs =+  foldTypeExpr+    TypeExprAlgebra+      { onText = [],+        onInt = [],+        onInteger = [],+        onBool = [],+        onNatural = [],+        onTime = [],+        onJson = [],+        onOptional = id,+        onList = id,+        onMap = id,+        onRef = pure+      }++emitMappedCodecs :: HaskellImportPlan -> Agg -> Text+emitMappedCodecs importPlan a = case (.typeGraph) a of+  Nothing -> ""+  Just graph ->+    T.intercalate+      "\n\n"+      [ emitStructuralCodec importPlan ((.context) a) graph declaration shape+      | ResolvedStructural declaration shape <- codecMappedDeclarations a+      ]++emitStructuralCodec :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text+emitStructuralCodec importPlan ctx graph declaration shape =+  nl+    [ "encode" <> name <> "Mapped :: " <> consumerType <> " -> Value",+      "encode" <> name <> "Mapped = encode" <> name <> "Shape . bindingToShape " <> binding,+      "",+      "parse" <> name <> "Mapped :: Value -> Parser " <> consumerType,+      "parse" <> name <> "Mapped value = bindingFromShape " <> binding <> " <$> parse" <> name <> "Shape value",+      "",+      "decode" <> name <> "Mapped :: Value -> Either Text " <> consumerType,+      "decode" <> name <> "Mapped = mapLeftText . parseEither parse" <> name <> "Mapped",+      "",+      "encode" <> name <> "Shape :: " <> shapeType <> " -> Value",+      emitShapeEncoder importPlan ctx graph declaration shape,+      "",+      "parse" <> name <> "Shape :: Value -> Parser " <> shapeType,+      emitShapeDecoder importPlan ctx graph declaration shape+    ]+  where+    name = (.name) declaration+    consumerType = renderReferenceOrDie importPlan (haskellTypeReference ((.haskell) declaration))+    shapeType = renderReferenceOrDie importPlan (qualifiedTypeReference (structuralShapeModule ctx name) (name <> "Shape"))+    binding = renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) declaration))++emitShapeEncoder :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text+emitShapeEncoder importPlan ctx graph declaration =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \_ _ fields ->+          nl $+            ["encode" <> name <> "Shape shape =", "  object"]+              <> objectEntries+                [ tshow ((.key) field)+                    <> " .= "+                    <> encodeShapeExpr graph ((.valueType) field) ("shape." <> (.haskell) field)+                | field <- fields+                ],+        onEnum = \entries ->+          nl $+            ["encode" <> name <> "Shape = \\case"]+              <> ["  " <> shapeConstructor ((.ctor) entry) <> " -> String " <> tshow ((.tag) entry) | entry <- entries],+        onUnion = \encoding arms ->+          nl $+            ["encode" <> name <> "Shape = \\case"]+              <> concatMap (unionEncodeArm encoding) arms+      }+  where+    name = (.name) declaration+    shapeModuleName = structuralShapeModule ctx name+    shapeConstructor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)+    unionEncodeArm encoding arm =+      [ "  " <> shapeConstructor ((.ctor) arm) <> payloadPattern <> " ->",+        "    object"+      ]+        <> objectEntries+          ( [tshow ((.tagField) encoding) <> " .= (" <> tshow ((.tag) arm) <> " :: Text)"]+              <> [ tshow ((.contentsField) encoding) <> " .= " <> encodeShapeExpr graph payload "payload"+                 | payload <- maybeToListText ((.payload) arm)+                 ]+          )+      where+        payloadPattern = maybe "" (const " payload") ((.payload) arm)++emitShapeDecoder :: HaskellImportPlan -> Context -> TypeGraph -> StructuralDecl -> ResolvedMappedShape -> Text+emitShapeDecoder importPlan ctx graph declaration =+  foldMappedShape+    MappedShapeAlgebra+      { onRecord = \constructor unknownFields fields ->+          nl $+            [ "parse" <> name <> "Shape = withObject " <> tshow (name <> "Shape") <> " $ \\objectValue -> do"+            ]+              <> rejectLine "  " unknownFields (map (.key) fields) "objectValue"+              <> [ "  " <> shapeConstructor constructor,+                   "    <$> " <> T.intercalate "\n    <*> " (map (decodeRecordField importPlan ctx graph) fields)+                 ],+        onEnum = \entries ->+          nl $+            [ "parse" <> name <> "Shape = withText " <> tshow (name <> "Shape") <> " $ \\tag -> case tag of"+            ]+              <> ["  " <> tshow ((.tag) entry) <> " -> pure " <> shapeConstructor ((.ctor) entry) | entry <- entries]+              <> ["  unknownTag -> " <> renderUnknownFailure (name <> " wire value") "unknownTag" (map (.tag) entries)],+        onUnion = \encoding arms ->+          nl $+            [ "parse" <> name <> "Shape = withObject " <> tshow (name <> "Shape") <> " $ \\objectValue -> do",+              "  tag <- explicitParseField (withText " <> tshow (name <> " tag") <> " validate" <> name <> "Tag) objectValue " <> tshow ((.tagField) encoding),+              "  case tag of"+            ]+              <> concatMap (unionDecodeArm encoding) arms+              <> [ "    _ -> fail \"validated union tag was not handled\"",+                   "",+                   "validate" <> name <> "Tag :: Text -> Parser Text",+                   "validate" <> name <> "Tag tag",+                   "  | tag `elem` " <> renderTextList (map (.tag) arms) <> " = pure tag",+                   "  | otherwise = " <> renderUnknownFailure (name <> " union tag") "tag" (map (.tag) arms)+                 ]+      }+  where+    name = (.name) declaration+    shapeModuleName = structuralShapeModule ctx name+    shapeConstructor constructor = renderReferenceOrDie importPlan (constructorReference shapeModuleName constructor)+    rejectLine _ IgnoreUnknown _ _ = []+    rejectLine indent RejectUnknown allowed objectName =+      [indent <> "rejectUnknownFields " <> tshow name <> " " <> renderTextList allowed <> " " <> objectName]+    unionDecodeArm encoding arm =+      ["    " <> tshow ((.tag) arm) <> " -> do"]+        <> rejectLine "      " ((.unknownFields) encoding) allowed "objectValue"+        <> [ case (.payload) arm of+               Nothing -> "      pure " <> shapeConstructor ((.ctor) arm)+               Just payload ->+                 "      "+                   <> shapeConstructor ((.ctor) arm)+                   <> " <$> explicitParseField ("+                   <> decodeShapeExpr graph payload+                   <> ") objectValue "+                   <> tshow ((.contentsField) encoding)+           ]+      where+        allowed = (.tagField) encoding : [(.contentsField) encoding | (.payload) arm /= Nothing]++decodeRecordField :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedWireField -> Text+decodeRecordField importPlan ctx graph field = case (.presence) field of+  PRequired ->+    "explicitParseField (" <> decoder <> ") objectValue " <> key+  POptional ->+    "parseOptionalField ("+      <> missing+      <> ") ("+      <> decoder+      <> ") objectValue "+      <> key+  where+    key = tshow ((.key) field)+    decoder = decodeShapeExpr graph ((.valueType) field)+    missing = case (.onMissing) field of+      Nothing -> "fail " <> tshow ("missing optional field without default: " <> (.key) field)+      Just onMissing -> "pure " <> renderMissingDefault importPlan ctx graph ((.valueType) field) onMissing++encodeShapeExpr :: TypeGraph -> ResolvedTypeExpr -> Text -> Text+encodeShapeExpr graph expression =+  renderMappedEncode graph StructuralShapeBoundary (mappedCodecPlanOrDie graph expression)++decodeShapeExpr :: TypeGraph -> ResolvedTypeExpr -> Text+decodeShapeExpr graph expression =+  renderMappedParse graph StructuralShapeBoundary (mappedCodecPlanOrDie graph expression)++mappedCodecPlanOrDie :: TypeGraph -> ResolvedTypeExpr -> MappedCodecPlan+mappedCodecPlanOrDie graph expression =+  either+    (error . ("validated mapped codec plan failed: " <>) . show)+    id+    (planMappedCodec graph expression)++renderMissingDefault :: HaskellImportPlan -> Context -> TypeGraph -> ResolvedTypeExpr -> OnMissing -> Text+renderMissingDefault importPlan ctx graph expression = \case+  OmNull -> "Nothing"+  OmText value -> tshow value+  OmInt value -> T.pack (show value)+  OmBool value -> if value then "True" else "False"+  OmEmptyList -> "[]"+  OmEmptyMap -> "Map.empty"+  OmCtor constructor -> case expression of+    RRef key -> case Map.lookup key ((.declarations) graph) of+      Just (ResolvedStructural declaration _) -> renderReferenceOrDie importPlan (constructorReference (structuralShapeModule ctx ((.name) declaration)) constructor)+      _ -> constructor+    _ -> constructor++objectEntries :: [Text] -> [Text]+objectEntries entries =+  [lead index <> entry | (index, entry) <- zip [(0 :: Int) ..] entries]+    <> ["      ]"]+  where+    lead 0 = "      [ "+    lead _ = "      , "++renderTextList :: [Text] -> Text+renderTextList values = "[" <> T.intercalate ", " (map tshow values) <> "]"++-- | Emit a parser failure that names the rejected runtime value and the full,+-- deterministic wire set accepted at that point.+renderUnknownFailure :: Text -> Text -> [Text] -> Text+renderUnknownFailure label variable expected =+  "fail ("+    <> tshow ("unknown " <> label <> " ")+    <> " <> show "+    <> variable+    <> " <> "+    <> tshow ("; expected one of: " <> expectedText)+    <> ")"+  where+    expectedText = case expected of+      [] -> "<none>"+      values -> T.intercalate ", " values++renderUnknownEventTypeFailure :: Agg -> Text -> Text+renderUnknownEventTypeFailure aggregate variable =+  "fail ("+    <> tshow "unknown event type "+    <> " <> show "+    <> variable+    <> " <> "+    <> tshow "; expected one of: "+    <> " <> renderExpectedEventTypes "+    <> eventTypesName aggregate+    <> ")"++--------------------------------------------------------------------------------+-- Authoritative version-2 expressions and transducer+--------------------------------------------------------------------------------++hasVersion2Ownership :: Agg -> Bool+hasVersion2Ownership = any ((/= LegacyHoleImplementation) . (.implementation)) . (.transitions)++transitionEntries :: Agg -> [(Int, Transition)]+transitionEntries aggregate =+  [ ((.declarationIndex) entry, (.transition) entry)+  | entry <- transitionLayout ((.transitions) aggregate)+  ]++transitionStem :: Int -> Transition -> Text+transitionStem index transition =+  "transition"+    <> tshow' index+    <> pascal ((.source) transition)+    <> pascal ((.command) transition)++guardFunctionName :: Int -> Transition -> Text+guardFunctionName index transition = transitionStem index transition <> "Guard"++writeFunctionName :: Int -> Transition -> Name -> Text+writeFunctionName index transition registerName =+  transitionStem index transition <> "Write" <> pascal registerName++holeFunctionName :: Int -> Transition -> Text+holeFunctionName index transition = transitionStem index transition <> "Hole"++holeFoldVersionName :: Int -> Transition -> Text+holeFoldVersionName index transition = holeFunctionName index transition <> "FoldVersion"++outputFunctionName :: Int -> Transition -> Int -> Name -> Text+outputFunctionName transitionIndex transition emitIndex eventName =+  transitionStem transitionIndex transition+    <> "Output"+    <> tshow' emitIndex+    <> pascal eventName++-- | Legacy create-once output-hook names made obsolete by authoritative+-- version-2 @fields(Command)@ generation.  Scaffolding reports these names as+-- safe-to-remove candidates without parsing or modifying consumer Haskell.+obsoleteGeneratedOutputHooks :: Spec -> [(Name, Text)]+obsoleteGeneratedOutputHooks spec = obsoleteGeneratedOutputHooksWith (eventOutputMapping spec) spec++obsoleteGeneratedOutputHooksForService :: CheckedService -> [(Name, Text)]+obsoleteGeneratedOutputHooksForService service =+  obsoleteGeneratedOutputHooksWith+    (eventOutputMappingFromGraphResult (checkedTypeGraph service) spec)+    spec+  where+    spec = checkedSpec service++obsoleteGeneratedOutputHooksWith :: (Aggregate -> Transition -> Int -> Name -> Either EventOutputError EventOutputMapping) -> Spec -> [(Name, Text)]+obsoleteGeneratedOutputHooksWith outputMapping spec =+  [ ( (.name) aggregate,+      outputFunctionName transitionIndex transition emitIndex eventName+    )+  | aggregate <- [value | NAggregate value <- (.nodes) spec],+    entry <- transitionLayout ((.transitions) aggregate),+    let transitionIndex = (.declarationIndex) entry+        transition = (.transition) entry,+    (emitIndex, eventName) <- zip [1 ..] ((.emits) transition),+    Right GeneratedCommandIdentity {} <- [outputMapping aggregate transition emitIndex eventName]+  ]++commandForTransition :: Agg -> Transition -> ResolvedCtor+commandForTransition aggregate transition =+  fromMaybe+    (error ("validated aggregate command disappeared: " <> T.unpack ((.command) transition)))+    (find ((== (.command) transition) . (.name)) ((.commands) aggregate))++eventForName :: Agg -> Name -> ResolvedCtor+eventForName aggregate eventName =+  fromMaybe+    (error ("validated aggregate event disappeared: " <> T.unpack eventName))+    (find ((== eventName) . (.name)) ((.events) aggregate))++commandFieldsType :: Transition -> Text+commandFieldsType transition = "RegFieldsOf " <> (.command) transition <> "Data"++payloadProjectionType :: Agg -> Transition -> Text+payloadProjectionType aggregate transition =+  "B.PayloadProj "+    <> (.name) aggregate+    <> "Regs "+    <> (.name) aggregate+    <> "Command ("+    <> commandFieldsType transition+    <> ")"++data ResolvedGeneratedTransition = ResolvedGeneratedTransition+  { index :: !Int,+    source :: !Transition,+    guard :: !(Maybe TypedScalarExpr),+    writes :: ![(Name, TypedScalarExpr)]+  }+  deriving stock (Eq, Show)++data SilentOutcomeKind = RejectedOutcome | NoOpOutcome+  deriving stock (Eq, Show)++data ResolvedSilentOutcome = ResolvedSilentOutcome+  { layout :: !TransitionLayoutEntry,+    kind :: !SilentOutcomeKind,+    reason :: !TypedScalarExpr+  }+  deriving stock (Eq, Show)++-- Resolve each generated-owned transition exactly once. Import analysis,+-- projection planning, and Haskell emission all consume this inventory.+resolvedGeneratedTransitions :: Agg -> [ResolvedGeneratedTransition]+resolvedGeneratedTransitions aggregate =+  [ ResolvedGeneratedTransition+      { index = index,+        source = transition,+        guard = resolvedGuard index transition <$> (.guard) transition,+        writes =+          [ (registerName, resolvedWrite index transition registerName expression)+          | (registerName, expression) <- (.writes) transition+          ]+      }+  | (index, transition) <- transitionEntries aggregate,+    (.implementation) transition == GeneratedImplementation+  ]+  where+    environment transition = expressionEnvironmentWith ((.symbols) aggregate) ((.typeGraph) aggregate) ((.spec) aggregate) ((.aggregate) aggregate) transition+    resolvedGuard index transition expression =+      expressionOrDie (guardFunctionName index transition) (resolveGuardExpr (environment transition) expression)+    resolvedWrite index transition registerName expression =+      expressionOrDie (writeFunctionName index transition registerName) (resolveWriteExpr (environment transition) registerName expression)++resolvedGeneratedExpressions :: Agg -> [TypedScalarExpr]+resolvedGeneratedExpressions = generatedTransitionExpressions . resolvedGeneratedTransitions++generatedTransitionExpressions :: [ResolvedGeneratedTransition] -> [TypedScalarExpr]+generatedTransitionExpressions = concatMap transitionExpressions+  where+    transitionExpressions resolved =+      maybe [] pure ((.guard) resolved)+        <> map snd ((.writes) resolved)++resolvedSilentOutcomes :: Agg -> [ResolvedSilentOutcome]+resolvedSilentOutcomes aggregate =+  [ ResolvedSilentOutcome+      { layout = entry,+        kind = kind,+        reason = resolveReason entry expected expression+      }+  | entry <- transitionLayout ((.transitions) aggregate),+    let transition = (.transition) entry,+    (.mode) transition == TmLive,+    (kind, expected, expression) <- outcomeReason transition+  ]+  where+    outcomeReason transition = case ((.domainOutcomeTypes) aggregate, (.outcome) transition) of+      (Just outcomeTypes, Just (OutcomeRejected expression _)) ->+        [(RejectedOutcome, (.rejectionType) outcomeTypes, expression)]+      (Just outcomeTypes, Just (OutcomeNoOp expression _)) ->+        [(NoOpOutcome, (.noOpType) outcomeTypes, expression)]+      _ -> []+    resolveReason entry expected expression =+      let transition = (.transition) entry+          owner = transitionStem ((.declarationIndex) entry) transition <> "OutcomeReason"+          environment = expressionEnvironmentWith ((.symbols) aggregate) ((.typeGraph) aggregate) ((.spec) aggregate) ((.aggregate) aggregate) transition+       in expressionOrDie owner (resolveScalarExpr environment (ExpectScalarType expected) expression)++resolvedOutcomeExpressions :: Agg -> [TypedScalarExpr]+resolvedOutcomeExpressions = map (.reason) . resolvedSilentOutcomes++-- | Guard expressions only.+--+-- A guard renders its operands as @K.Index … SomeType@ annotations and so needs+-- each operand type in scope. A write renders @B.slot \@"x" =: d.x@, whose type+-- is inferred — importing its source type adds an unused import, which is an+-- error under the generated-output @-Werror@. Literals name their type in either+-- position and are collected separately.+generatedTransitionGuards :: [ResolvedGeneratedTransition] -> [TypedScalarExpr]+generatedTransitionGuards = concatMap (maybe [] pure . (.guard))++-- | Every literal node in an expression tree.+typedExpressionLiterals :: TypedScalarExpr -> [TypedScalarExpr]+typedExpressionLiterals expression = own <> concatMap typedExpressionLiterals (typedExpressionChildren expression)+  where+    own = case (.node) expression of+      TypedLiteral {} -> [expression]+      _ -> []++-- | Types named by literal construction anywhere in an expression.+typedExpressionLiteralTypes :: TypedScalarExpr -> [ResolvedAggregateType]+typedExpressionLiteralTypes expression = own <> concatMap typedExpressionLiteralTypes (typedExpressionChildren expression)+  where+    own = case (.node) expression of+      TypedLiteral {} -> [(.valueType) expression]+      _ -> []++anyTypedExpression :: (TypedScalarExpr -> Bool) -> TypedScalarExpr -> Bool+anyTypedExpression predicate expression =+  predicate expression || any (anyTypedExpression predicate) (typedExpressionChildren expression)++typedExpressionChildren :: TypedScalarExpr -> [TypedScalarExpr]+typedExpressionChildren expression = case (.node) expression of+  TypedLiteral {} -> []+  TypedRoot {} -> []+  TypedProject {} -> []+  TypedAdd _ left right -> [left, right]+  TypedSubtract _ left right -> [left, right]+  TypedMultiply _ left right -> [left, right]+  TypedEqual left right -> [left, right]+  TypedNotEqual left right -> [left, right]+  TypedCompare _ left right -> [left, right]+  TypedAnd left right -> [left, right]+  TypedOr left right -> [left, right]++typedConsumerLiteralNominals :: TypedScalarExpr -> [ResolvedNominalType]+typedConsumerLiteralNominals expression = own <> concatMap typedConsumerLiteralNominals (typedExpressionChildren expression)+  where+    own = case ((.valueType) expression, (.node) expression) of+      (AggregateNominal nominal, TypedLiteral ScalarEnumValue {})+        | ConsumerNominal {} <- (.ownership) nominal -> [nominal]+      (AggregateNominal nominal, TypedLiteral ScalarIdValue {})+        | ConsumerNominal {} <- (.ownership) nominal -> [nominal]+      _ -> []++typedGeneratedNominals :: TypedScalarExpr -> [ResolvedNominalType]+typedGeneratedNominals expression = own <> concatMap typedGeneratedNominals (typedExpressionChildren expression)+  where+    own = case (.valueType) expression of+      AggregateNominal nominal+        | GeneratedNominal <- (.ownership) nominal -> [nominal]+      _ -> []++expressionOrDie :: Text -> Either (NonEmpty ExpressionDiagnostic) TypedScalarExpr -> TypedScalarExpr+expressionOrDie owner = either (error . (("validated expression disappeared for " <> T.unpack owner <> ": ") <>) . show) id++data ProjectionAliasTarget+  = StructuralProjectionAlias !ScalarRootProvenance !ResolvedScalarProjection+  | NominalProjectionAlias !ResolvedNominalType !ScalarRootProvenance+  deriving stock (Eq, Show)++data ProjectionAlias = ProjectionAlias+  { target :: !ProjectionAliasTarget,+    name :: !Text+  }+  deriving stock (Eq, Show)++projectionAliasesForTransition :: ResolvedGeneratedTransition -> [ProjectionAlias]+projectionAliasesForTransition resolved = allocateAliases targets+  where+    expressions =+      maybe [] pure ((.guard) resolved)+        <> map snd ((.writes) resolved)+    targets = nub (concatMap projectionAliasTargets expressions)++projectionAliasTargets :: TypedScalarExpr -> [ProjectionAliasTarget]+projectionAliasTargets expression = own <> comparisonTargets <> concatMap projectionAliasTargets children+  where+    children = typedExpressionChildren expression+    own = case (.node) expression of+      TypedProject provenance projection -> [StructuralProjectionAlias provenance projection]+      _ -> []+    comparisonTargets = case (.node) expression of+      TypedEqual left right -> mapMaybe nominalTarget [left, right]+      TypedNotEqual left right -> mapMaybe nominalTarget [left, right]+      _ -> []+    nominalTarget operand = case ((.valueType) operand, (.node) operand) of+      (AggregateNominal nominal, TypedRoot provenance)+        | nominalComparisonProjection nominal -> Just (NominalProjectionAlias nominal provenance)+      _ -> Nothing++allocateAliases :: [ProjectionAliasTarget] -> [ProjectionAlias]+allocateAliases = snd . foldl allocate (Map.empty, [])+  where+    allocate (counts, aliases) target =+      let base = projectionAliasBase target+          occurrence = Map.findWithDefault 0 base counts + 1+          alias = if occurrence == 1 then base else base <> tshow' occurrence+       in (Map.insert base occurrence counts, aliases <> [ProjectionAlias target alias])++projectionAliasBase :: ProjectionAliasTarget -> Text+projectionAliasBase target = prefix <> pascal rootName <> pathSuffix+  where+    provenance = case target of+      StructuralProjectionAlias value _ -> value+      NominalProjectionAlias _ value -> value+    (prefix, rootName) = case provenance of+      ScalarRegisterRoot name _ -> ("register", name)+      ScalarCommandRoot name _ -> ("command", name)+    pathSuffix = case target of+      NominalProjectionAlias {} -> ""+      StructuralProjectionAlias _ projection ->+        T.concat+          [ normaliseAliasPart (unescapePointer segment)+          | segment <- filter (not . T.null) (T.splitOn "/" ((.pointer) projection))+          ]++normaliseAliasPart :: Text -> Text+normaliseAliasPart value = case filter (not . T.null) (T.split (not . isAlphaNum) value) of+  [] -> "Field"+  pieces -> T.concat (map pascal pieces)++unescapePointer :: Text -> Text+unescapePointer = T.replace "~0" "~" . T.replace "~1" "/"++projectionAliasFor :: [ProjectionAlias] -> ProjectionAliasTarget -> Text+projectionAliasFor aliases target =+  maybe+    (error ("resolved projection alias disappeared: " <> show target))+    (.name)+    (find ((== target) . (.target)) aliases)++data RenderAssociativity = RenderLeft | RenderRight | RenderNonAssociative+  deriving stock (Eq, Show)++data RenderOperandSide = RenderLeftOperand | RenderRightOperand+  deriving stock (Eq, Show)++data RenderedKeikiExpr = RenderedKeikiExpr+  { text :: !Text,+    precedence :: !Int+  }+  deriving stock (Eq, Show)++renderedAtom :: Text -> RenderedKeikiExpr+renderedAtom value = RenderedKeikiExpr value 10++renderedInfix :: Int -> RenderAssociativity -> Text -> RenderedKeikiExpr -> RenderedKeikiExpr -> RenderedKeikiExpr+renderedInfix precedence associativity operator left right =+  RenderedKeikiExpr+    ( renderInfixChild precedence associativity RenderLeftOperand left+        <> " "+        <> operator+        <> " "+        <> renderInfixChild precedence associativity RenderRightOperand right+    )+    precedence++renderInfixChild :: Int -> RenderAssociativity -> RenderOperandSide -> RenderedKeikiExpr -> Text+renderInfixChild parentPrecedence associativity side child+  | (.precedence) child > parentPrecedence = (.text) child+  | (.precedence) child < parentPrecedence = parenthesized+  | otherwise = case associativity of+      RenderLeft+        | side == RenderLeftOperand -> (.text) child+      RenderRight+        | side == RenderRightOperand -> (.text) child+      _ -> parenthesized+  where+    parenthesized = "(" <> (.text) child <> ")"++renderKeikiPredicate :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> Text+renderKeikiPredicate importPlan aliases aggregate transition =+  (.text) . renderPredicate+  where+    renderPredicate expression = case (.node) expression of+      TypedEqual left right -> comparison ".==" left right+      TypedNotEqual left right -> comparison "./=" left right+      TypedCompare operator left right -> comparison (renderComparisonOperator operator) left right+      TypedAnd left right -> boolean 3 RenderRight ".&&" left right+      TypedOr left right -> boolean 2 RenderRight ".||" left right+      _ ->+        renderedInfix+          4+          RenderNonAssociative+          ".=="+          (renderKeikiTerm importPlan aliases aggregate transition expression)+          (renderedAtom "K.lit True")+    comparison operator left right =+      renderedInfix+        4+        RenderNonAssociative+        operator+        (renderComparisonTerm importPlan aliases aggregate transition left)+        (renderComparisonTerm importPlan aliases aggregate transition right)+    boolean precedence associativity operator left right =+      renderedInfix precedence associativity operator (renderPredicate left) (renderPredicate right)++renderComparisonOperator :: CmpOp -> Text+renderComparisonOperator = \case+  OpEq -> ".=="+  OpNeq -> "./="+  OpLt -> ".<"+  OpLe -> ".<="+  OpGt -> ".>"+  OpGe -> ".>="++renderComparisonTerm :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr+renderComparisonTerm importPlan aliases aggregate transition expression = case ((.valueType) expression, (.node) expression) of+  (AggregateNominal nominal, TypedRoot provenance)+    | nominalComparisonProjection nominal ->+        renderedAtom (projectionAliasFor aliases (NominalProjectionAlias nominal provenance))+  (AggregateNominal nominal, TypedLiteral (ScalarEnumValue _ constructor)) ->+    renderedAtom ("K.lit (" <> tshow (enumWireFor nominal constructor) <> " :: Text)")+  (AggregateNominal _, TypedLiteral (ScalarIdValue _ value)) ->+    renderedAtom ("K.lit (" <> tshow value <> " :: Text)")+  _ -> renderKeikiTerm importPlan aliases aggregate transition expression++nominalComparisonProjection :: ResolvedNominalType -> Bool+nominalComparisonProjection nominal = case (.representation) nominal of+  IdRepresentation {} -> True+  EnumRepresentation {} -> True+  ScalarRepresentation {} -> case (.ownership) nominal of+    ConsumerNominal {} -> True+    GeneratedNominal -> False++enumWireFor :: ResolvedNominalType -> Name -> Text+enumWireFor nominal constructor = case (.representation) nominal of+  EnumRepresentation constructors -> fromMaybe (error "validated enum literal lost its wire spelling") (lookup constructor (NE.toList constructors))+  _ -> error "validated enum literal lost its enum representation"++renderNominalProjectionTerm :: HaskellImportPlan -> Agg -> Transition -> ResolvedNominalType -> ScalarRootProvenance -> Text+renderNominalProjectionTerm importPlan aggregate transition nominal provenance = case provenance of+  ScalarRegisterRoot registerName ownerType ->+    "K.regProj "+      <> projectionQualifier+      <> "."+      <> witness+      <> " (#"+      <> registerName+      <> " :: K.Index "+      <> (.name) aggregate+      <> "Regs "+      <> renderDomainType importPlan aggregate ownerType+      <> ")"+  ScalarCommandRoot name ownerType ->+    "K.inpProj "+      <> projectionQualifier+      <> "."+      <> witness+      <> " inCtor"+      <> (.command) transition+      <> " (#"+      <> commandFieldSelector aggregate ((.command) transition) name+      <> " :: K.Index ("+      <> commandFieldsType transition+      <> ") "+      <> renderDomainType importPlan aggregate ownerType+      <> ")"+  where+    projectionQualifier = case (.ownership) nominal of+      GeneratedNominal -> "GeneratedNominals"+      ConsumerNominal {} -> "NominalProjections"+    witness = case (.representation) nominal of+      ScalarRepresentation {} -> lowerFirst ((.name) nominal) <> "Witness"+      IdRepresentation {} -> nominalEqualityWitnessName nominal+      EnumRepresentation {} -> nominalEqualityWitnessName nominal++renderKeikiTerm :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr+renderKeikiTerm importPlan aliases aggregate transition expression = case (.node) expression of+  TypedLiteral value -> renderedAtom (renderKeikiLiteral importPlan aggregate ((.valueType) expression) value)+  TypedRoot (ScalarRegisterRoot registerName _) -> renderedAtom ("B.reg @" <> tshow registerName)+  TypedRoot (ScalarCommandRoot name _) ->+    renderedAtom ("d." <> commandFieldSelector aggregate ((.command) transition) name)+  TypedProject provenance projection ->+    renderedAtom (projectionAliasFor aliases (StructuralProjectionAlias provenance projection))+  TypedAdd _ left right -> arithmetic 6 ".+" left right+  TypedSubtract _ left right -> arithmetic 6 ".-" left right+  TypedMultiply _ left right -> arithmetic 7 ".*" left right+  TypedEqual {} -> impossiblePredicate+  TypedNotEqual {} -> impossiblePredicate+  TypedCompare {} -> impossiblePredicate+  TypedAnd {} -> impossiblePredicate+  TypedOr {} -> impossiblePredicate+  where+    arithmetic precedence operator left right =+      renderedInfix+        precedence+        RenderLeft+        operator+        (renderKeikiTerm importPlan aliases aggregate transition left)+        (renderKeikiTerm importPlan aliases aggregate transition right)+    impossiblePredicate = error "predicate-valued Boolean expressions cannot be lowered as register terms"++renderOutcomeReasonEvaluation :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> Text+renderOutcomeReasonEvaluation importPlan aggregate transition expression =+  evaluator+    <> " ("+    <> (.text) rendered+    <> ") registers command"+  where+    (evaluator, rendered) = case (.node) expression of+      TypedEqual {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)+      TypedNotEqual {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)+      TypedCompare {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)+      TypedAnd {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)+      TypedOr {} -> ("K.evalPred", renderOutcomePredicate importPlan aggregate transition expression)+      _ -> ("K.evalTerm", renderOutcomeKeikiTerm importPlan aggregate transition expression)++renderOutcomePredicate :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr+renderOutcomePredicate importPlan aggregate transition = renderPredicate+  where+    renderPredicate expression = case (.node) expression of+      TypedEqual left right -> comparison ".==" left right+      TypedNotEqual left right -> comparison "./=" left right+      TypedCompare operator left right -> comparison (renderComparisonOperator operator) left right+      TypedAnd left right -> boolean 3 RenderRight ".&&" left right+      TypedOr left right -> boolean 2 RenderRight ".||" left right+      _ ->+        renderedInfix+          4+          RenderNonAssociative+          ".=="+          (renderOutcomeKeikiTerm importPlan aggregate transition expression)+          (renderedAtom "K.lit True")+    comparison operator left right =+      renderedInfix+        4+        RenderNonAssociative+        operator+        (renderOutcomeComparisonTerm importPlan aggregate transition left)+        (renderOutcomeComparisonTerm importPlan aggregate transition right)+    boolean precedence associativity operator left right =+      renderedInfix precedence associativity operator (renderPredicate left) (renderPredicate right)++renderOutcomeComparisonTerm :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr+renderOutcomeComparisonTerm importPlan aggregate transition expression = case ((.valueType) expression, (.node) expression) of+  (AggregateNominal nominal, TypedRoot provenance)+    | nominalComparisonProjection nominal ->+        renderedAtom (renderNominalProjectionTerm importPlan aggregate transition nominal provenance)+  (AggregateNominal nominal, TypedLiteral (ScalarEnumValue _ constructor)) ->+    renderedAtom ("K.lit (" <> tshow (enumWireFor nominal constructor) <> " :: Text)")+  (AggregateNominal _, TypedLiteral (ScalarIdValue _ value)) ->+    renderedAtom ("K.lit (" <> tshow value <> " :: Text)")+  _ -> renderOutcomeKeikiTerm importPlan aggregate transition expression++renderOutcomeKeikiTerm :: HaskellImportPlan -> Agg -> Transition -> TypedScalarExpr -> RenderedKeikiExpr+renderOutcomeKeikiTerm importPlan aggregate transition expression = case (.node) expression of+  TypedLiteral value -> renderedAtom (renderKeikiLiteral importPlan aggregate ((.valueType) expression) value)+  TypedRoot (ScalarRegisterRoot registerName _) -> renderedAtom ("B.reg @" <> tshow registerName)+  TypedRoot (ScalarCommandRoot name ownerType) ->+    renderedAtom+      ( "K.inpCtor inCtor"+          <> (.command) transition+          <> " (#"+          <> commandFieldSelector aggregate ((.command) transition) name+          <> " :: K.Index ("+          <> commandFieldsType transition+          <> ") "+          <> renderDomainType importPlan aggregate ownerType+          <> ")"+      )+  TypedProject provenance projection ->+    renderedAtom (renderStructuralProjectionTerm importPlan aggregate transition provenance projection)+  TypedAdd _ left right -> arithmetic 6 ".+" left right+  TypedSubtract _ left right -> arithmetic 6 ".-" left right+  TypedMultiply _ left right -> arithmetic 7 ".*" left right+  TypedEqual {} -> impossiblePredicate+  TypedNotEqual {} -> impossiblePredicate+  TypedCompare {} -> impossiblePredicate+  TypedAnd {} -> impossiblePredicate+  TypedOr {} -> impossiblePredicate+  where+    arithmetic precedence operator left right =+      renderedInfix+        precedence+        RenderLeft+        operator+        (renderOutcomeKeikiTerm importPlan aggregate transition left)+        (renderOutcomeKeikiTerm importPlan aggregate transition right)+    impossiblePredicate = error "predicate-valued Boolean outcome cannot be lowered as a Keiki term"++renderStructuralProjectionTerm :: HaskellImportPlan -> Agg -> Transition -> ScalarRootProvenance -> ResolvedScalarProjection -> Text+renderStructuralProjectionTerm importPlan aggregate transition provenance projection = case provenance of+  ScalarRegisterRoot registerName ownerType ->+    "K.regProj StructuralProjections."+      <> witness+      <> " (#"+      <> registerName+      <> " :: K.Index "+      <> (.name) aggregate+      <> "Regs "+      <> renderDomainType importPlan aggregate ownerType+      <> ")"+  ScalarCommandRoot name ownerType ->+    "K.inpProj StructuralProjections."+      <> witness+      <> " inCtor"+      <> (.command) transition+      <> " (#"+      <> commandFieldSelector aggregate ((.command) transition) name+      <> " :: K.Index ("+      <> commandFieldsType transition+      <> ") "+      <> renderDomainType importPlan aggregate ownerType+      <> ")"+  where+    witness =+      fromMaybe+        (error ("resolved structural projection witness disappeared: " <> show projection))+        ((.typeGraph) aggregate >>= \graph -> projectionWitnessName graph ((.owner) projection) ((.pointer) projection))++renderKeikiLiteral :: HaskellImportPlan -> Agg -> ResolvedAggregateType -> ScalarValue -> Text+renderKeikiLiteral importPlan aggregate scalarType = \case+  ScalarTextValue value -> "K.lit (" <> tshow value <> " :: Text)"+  ScalarIntValue value -> "K.lit (" <> tshow' value <> " :: Int)"+  ScalarIntegerValue value -> "K.lit (" <> T.pack (show value) <> " :: Integer)"+  ScalarNaturalValue value -> "K.lit (" <> T.pack (show value) <> " :: Natural)"+  ScalarBoolValue value -> "K.lit " <> if value then "True" else "False"+  ScalarTimeValue value -> "K.lit " <> renderRegisterInitial (InitialTime value)+  ScalarEnumValue _typeName constructor -> case scalarType of+    AggregateNominal nominal -> case (.ownership) nominal of+      GeneratedNominal -> "K.lit " <> constructor+      ConsumerNominal binding ->+        "K.lit (nominalFromRepresentation "+          <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+          <> " "+          <> renderReferenceOrDie importPlan (nominalRepresentationConstructorReference ((.context) aggregate) nominal constructor)+          <> ")"+    _ -> error "validated enum literal lost its nominal type"+  ScalarIdValue typeName value -> case scalarType of+    AggregateNominal nominal -> case (.ownership) nominal of+      GeneratedNominal -> case idDomainContractFor ((.languageContract) aggregate) =<< idPrefixOf nominal of+        Nothing -> "K.lit (" <> typeName <> " " <> tshow value <> ")"+        Just _ ->+          "K.lit (case parse"+            <> typeName+            <> " "+            <> tshow value+            <> " of Right parsed -> parsed; Left _ -> error \"validated ID literal failed to parse\")"+      ConsumerNominal binding -> case (.representation) nominal of+        IdRepresentation prefix ->+          "K.lit (nominalFromRepresentation "+            <> renderReferenceOrDie importPlan (qualifiedValueReference ((.binding) binding))+            <> " (case KindID.parseText @"+            <> tshow prefix+            <> " "+            <> tshow value+            <> " of Right parsed -> parsed; Left _ -> error \"validated ID literal failed to parse\"))"+        _ -> error "validated ID literal lost its ID representation"+    _ -> error "validated ID literal lost its nominal type"+  where+    idPrefixOf nominal = case (.representation) nominal of+      IdRepresentation prefix -> Just prefix+      _ -> Nothing++generatedIdSampleHaskell :: Agg -> ResolvedNominalType -> Maybe Text+generatedIdSampleHaskell aggregate nominal = do+  prefix <- case (.representation) nominal of+    IdRepresentation value -> Just value+    _ -> Nothing+  contract <- idDomainContractFor ((.languageContract) aggregate) prefix+  let name = (.name) nominal+      sample = idDomainSampleText contract+  pure+    ( "(case parse"+        <> name+        <> " "+        <> tshow sample+        <> " of Right parsed -> parsed; Left _ -> error \"generated valid ID sample failed to parse\")"+    )++emitGeneratedTransducer :: Agg -> Text+emitGeneratedTransducer aggregate =+  nl $+    renderGeneratedLanguagePragmas+      ( [ExtBlockArguments, ExtQualifiedDo]+          <> [ExtOverloadedLabels | not (null projectionAliases)]+          <> [ExtOverloadedRecordDot | transducerUsesRecordDot aggregate]+      )+      ++ [ generatedBanner,+           "module " <> (.genPrefix) aggregate <> ".Transducer",+           "  ( " <> lowerFirst ((.name) aggregate) <> "Transducer",+           "  , " <> lowerFirst ((.name) aggregate) <> "FoldFingerprint",+           "  , BehaviorOwnership (..)",+           "  , " <> lowerFirst ((.name) aggregate) <> "PredicateVerifications",+           "  ) where",+           "",+           "import " <> (.genPrefix) aggregate <> ".Domain",+           "import Data.Text (Text)"+         ]+      ++ ["import Data.Time.Calendar (fromGregorian)" | expressionUsesTimeLiteral]+      ++ ["import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)" | expressionUsesTimeLiteral]+      ++ ["import Numeric.Natural (Natural)" | expressionUsesNaturalLiteral]+      ++ generatedNominalTypeImportsWithParsers+        (aggregateCheckedService aggregate)+        ((.context) aggregate)+        generatedExpressionNominals+        generatedLiteralNominals+      ++ structuralProjectionImport+      ++ generatedNominalProjectionImport+      ++ consumerNominalProjectionImport+      ++ consumerImports+      ++ ["import Data.KindID qualified as KindID" | expressionUsesConsumerIdLiteral]+      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation)" | expressionUsesConsumerNominalLiteral]+      ++ [ "import Keiki.Builder qualified as B",+           "import Keiki.Core (" <> T.intercalate ", " keikiCoreImports <> ")",+           "import Keiki.Core qualified as K",+           "import Keiki.Symbolic qualified as S"+         ]+      ++ ["import " <> (.holePrefix) aggregate <> ".Holes qualified as Holes" | transducerUsesHoles aggregate]+      ++ ["import Data.Text qualified as T" | anyHoleOwned aggregate]+      ++ ["import Keiki.Builder ((=:))" | any (not . null . (.writes) . snd) (transitionEntries aggregate)]+      ++ ["import Keiki.Generics (RegFieldsOf)" | not (null projectionAliases)]+      ++ ["import Keiro.Snapshot.Codec (FoldVersion (..))" | anyHoleOwned aggregate]+      ++ [ "",+           lowerFirst ((.name) aggregate) <> "Transducer",+           "  :: SymTransducer",+           "       (HsPred " <> (.name) aggregate <> "Regs " <> (.name) aggregate <> "Command)",+           "       " <> (.name) aggregate <> "Regs",+           "       " <> (.vertexType) aggregate,+           "       " <> (.name) aggregate <> "Command",+           "       " <> (.name) aggregate <> "Event",+           lowerFirst ((.name) aggregate) <> "Transducer =",+           "  B.buildTransducer " <> initialVertex aggregate <> " initial" <> (.name) aggregate <> "Regs isTerminal do",+           nl (concatMap (generatedFromBlock importPlan aggregate resolvedTransitions) (groupTransitionEntriesBySource aggregate)),+           " where",+           "  isTerminal = \\case",+           nl ["    " <> vertexCtor aggregate ((.name) state) <> " -> True" | state <- (.states) aggregate, (.terminal) state],+           "    _ -> False",+           "",+           lowerFirst ((.name) aggregate) <> "FoldFingerprint :: Text",+           lowerFirst ((.name) aggregate) <> "FoldFingerprint = " <> foldFingerprintExpression aggregate,+           "",+           "data BehaviorOwnership = GeneratedOwned | HoleOwned",+           "  deriving stock (Eq, Show)",+           "",+           "-- Every checked transition predicate is audited through Keiki's conservative",+           "-- symbolic verifier. Opaque Hole terms remain explicitly unverified.",+           lowerFirst ((.name) aggregate) <> "PredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]",+           lowerFirst ((.name) aggregate) <> "PredicateVerifications = sequence",+           nl (renderVerificationList aggregate),+           " where",+           "  verifyTransition label owner source edgeIndex =",+           "    case drop edgeIndex (K.edgesOut " <> lowerFirst ((.name) aggregate) <> "Transducer source) of",+           "      K.Edge predicate _ _ _ _ : _ -> (\\result -> (label, owner, result)) <$> S.verifyPredicate predicate",+           "      [] -> pure (label, owner, S.UnverifiedSolverFailure \"generated transition edge missing\")"+         ]+  where+    resolvedTransitions = resolvedGeneratedTransitions aggregate+    resolvedExpressions = generatedTransitionExpressions resolvedTransitions+    projectionAliases = concatMap projectionAliasesForTransition resolvedTransitions+    projectionTargets = map (.target) projectionAliases+    structuralProjectionImport =+      [ "import " <> structuralProjectionModule ((.context) aggregate) <> " qualified as StructuralProjections"+      | any isStructuralProjection projectionTargets+      ]+    generatedNominalProjectionImport =+      [ "import " <> generatedNominalModule ((.context) aggregate) <> " qualified as GeneratedNominals"+      | any isGeneratedNominalProjection projectionTargets+      ]+    consumerNominalProjectionImport =+      [ "import " <> nominalProjectionModule ((.context) aggregate) <> " qualified as NominalProjections"+      | any isConsumerNominalProjection projectionTargets+      ]+    consumerImports =+      T.lines (renderPlannedImports importPlan)+    expressionImportTypes =+      nub+        ( concatMap typedExpressionImportTypes (generatedTransitionGuards resolvedTransitions)+            <> concatMap typedExpressionLiteralTypes resolvedExpressions+        )+    consumerLiteralNominals = nub [nominal | expression <- resolvedExpressions, nominal <- typedConsumerLiteralNominals expression]+    importPlan = transducerImportPlan aggregate expressionImportTypes consumerLiteralNominals+    generatedExpressionNominals =+      stableNominals+        [ nominal+        | expression <- resolvedExpressions,+          nominal <- typedGeneratedNominals expression+        ]+    -- Only a literal names `parse<Id>`; see 'generatedNominalTypeImportsWithParsers'.+    generatedLiteralNominals =+      stableNominals+        [ nominal+        | expression <- resolvedExpressions,+          literal <- typedExpressionLiterals expression,+          nominal <- typedGeneratedNominals literal+        ]+    expressionUsesTimeLiteral = any (anyTypedExpression isTimeLiteral) resolvedExpressions+    expressionUsesNaturalLiteral = any (anyTypedExpression isNaturalLiteral) resolvedExpressions+    expressionUsesConsumerNominalLiteral = not (null consumerLiteralNominals)+    expressionUsesConsumerIdLiteral = any (isIdRepresentation . (.representation)) consumerLiteralNominals+    usedOperators = nub (concatMap generatedTransitionOperators resolvedTransitions)+    keikiCoreImports = ["HsPred", "SymTransducer"] <> ["(" <> operator <> ")" | operator <- expressionOperatorOrder, operator `elem` usedOperators]+    isTimeLiteral expression = case (.node) expression of+      TypedLiteral ScalarTimeValue {} -> True+      _ -> False+    isNaturalLiteral expression = case (.node) expression of+      TypedLiteral ScalarNaturalValue {} -> True+      _ -> False+    isIdRepresentation IdRepresentation {} = True+    isIdRepresentation _ = False++transducerUsesRecordDot :: Agg -> Bool+transducerUsesRecordDot aggregate =+  any expressionUsesCommandRoot (resolvedGeneratedExpressions aggregate)+    || any generatedOutputUsesCommandField generatedOutputs+  where+    generatedOutputs =+      [ outputMappingFor aggregate transitionIndex emitIndex+      | (transitionIndex, transition) <- transitionEntries aggregate,+        (.implementation) transition == GeneratedImplementation,+        emitIndex <- [1 .. length ((.emits) transition)]+      ]+    generatedOutputUsesCommandField (GeneratedCommandIdentity _ fields) = not (null fields)+    generatedOutputUsesCommandField HandOwnedEventOutput {} = False+    expressionUsesCommandRoot = anyTypedExpression isCommandRoot+    isCommandRoot expression = case (.node) expression of+      TypedRoot ScalarCommandRoot {} -> True+      _ -> False++transducerImportPlan :: Agg -> [ResolvedAggregateType] -> [ResolvedNominalType] -> HaskellImportPlan+transducerImportPlan aggregate importedTypes literalNominals =+  planImportsOrDie+    ((.genPrefix) aggregate <> ".Transducer")+    (Set.fromList [(.name) aggregate <> "Regs", (.name) aggregate <> "Command", (.name) aggregate <> "Event"])+    ( Set.unions+        [ aggregateSourceReferences (aggregateConsumerHaskellSource ((.symbols) aggregate) resolvedType)+        | resolvedType <- importedTypes+        ]+        <> Set.fromList+          [ reference+          | nominal <- literalNominals,+            ConsumerNominal binding <- [(.ownership) nominal],+            reference <-+              qualifiedValueReference ((.binding) binding)+                : case (.representation) nominal of+                  EnumRepresentation constructors ->+                    [ nominalRepresentationConstructorReference ((.context) aggregate) nominal constructor+                    | (constructor, _) <- NE.toList constructors+                    ]+                  _ -> []+          ]+    )++typedExpressionImportTypes :: TypedScalarExpr -> [ResolvedAggregateType]+typedExpressionImportTypes expression = own <> concatMap typedExpressionImportTypes (typedExpressionChildren expression)+  where+    own = case (.node) expression of+      TypedLiteral {} -> [(.valueType) expression]+      TypedRoot provenance -> [scalarRootType provenance]+      TypedProject provenance _ -> [scalarRootType provenance]+      _ -> []++scalarRootType :: ScalarRootProvenance -> ResolvedAggregateType+scalarRootType = \case+  ScalarRegisterRoot _ resolvedType -> resolvedType+  ScalarCommandRoot _ resolvedType -> resolvedType++isStructuralProjection :: ProjectionAliasTarget -> Bool+isStructuralProjection StructuralProjectionAlias {} = True+isStructuralProjection NominalProjectionAlias {} = False++isGeneratedNominalProjection :: ProjectionAliasTarget -> Bool+isGeneratedNominalProjection (NominalProjectionAlias nominal _) = (.ownership) nominal == GeneratedNominal+isGeneratedNominalProjection StructuralProjectionAlias {} = False++isConsumerNominalProjection :: ProjectionAliasTarget -> Bool+isConsumerNominalProjection (NominalProjectionAlias nominal _) = case (.ownership) nominal of+  ConsumerNominal {} -> True+  GeneratedNominal -> False+isConsumerNominalProjection StructuralProjectionAlias {} = False++expressionOperatorOrder :: [Text]+expressionOperatorOrder = [".*", ".+", ".-", ".==", "./=", ".<", ".<=", ".>", ".>=", ".&&", ".||"]++generatedTransitionOperators :: ResolvedGeneratedTransition -> [Text]+generatedTransitionOperators resolved =+  maybe [] expressionPredicateOperators ((.guard) resolved)+    <> concatMap (expressionTermOperators . snd) ((.writes) resolved)++outcomeExpressionOperators :: TypedScalarExpr -> [Text]+outcomeExpressionOperators expression = case (.node) expression of+  TypedEqual {} -> expressionPredicateOperators expression+  TypedNotEqual {} -> expressionPredicateOperators expression+  TypedCompare {} -> expressionPredicateOperators expression+  TypedAnd {} -> expressionPredicateOperators expression+  TypedOr {} -> expressionPredicateOperators expression+  _ -> expressionTermOperators expression++expressionPredicateOperators :: TypedScalarExpr -> [Text]+expressionPredicateOperators expression = case (.node) expression of+  TypedEqual left right -> ".==" : expressionTermOperators left <> expressionTermOperators right+  TypedNotEqual left right -> "./=" : expressionTermOperators left <> expressionTermOperators right+  TypedCompare operator left right -> renderComparisonOperator operator : expressionTermOperators left <> expressionTermOperators right+  TypedAnd left right -> ".&&" : expressionPredicateOperators left <> expressionPredicateOperators right+  TypedOr left right -> ".||" : expressionPredicateOperators left <> expressionPredicateOperators right+  _ -> ".==" : expressionTermOperators expression++expressionTermOperators :: TypedScalarExpr -> [Text]+expressionTermOperators expression = case (.node) expression of+  TypedAdd _ left right -> ".+" : expressionTermOperators left <> expressionTermOperators right+  TypedSubtract _ left right -> ".-" : expressionTermOperators left <> expressionTermOperators right+  TypedMultiply _ left right -> ".*" : expressionTermOperators left <> expressionTermOperators right+  _ -> concatMap expressionTermOperators (typedExpressionChildren expression)++anyHoleOwned :: Agg -> Bool+anyHoleOwned = any ((== HoleImplementation) . (.implementation)) . (.transitions)++transducerUsesHoles :: Agg -> Bool+transducerUsesHoles aggregate =+  anyHoleOwned aggregate+    || any isHandOwned (Map.elems ((.outputMappings) aggregate))+  where+    isHandOwned HandOwnedEventOutput {} = True+    isHandOwned GeneratedCommandIdentity {} = False++renderVerificationList :: Agg -> [Text]+renderVerificationList aggregate =+  [ (if listIndex == (0 :: Int) then "  [ " else "  , ")+      <> "verifyTransition "+      <> tshow (transitionStem transitionIndex transition)+      <> " "+      <> ownership+      <> " "+      <> vertexCtor aggregate source+      <> " "+      <> tshow' edgeIndex+  | (listIndex, (source, edgeIndex, transitionIndex, transition)) <- zip [0 ..] entries,+    let ownership = case (.implementation) transition of+          GeneratedImplementation -> "GeneratedOwned"+          HoleImplementation -> "HoleOwned"+          LegacyHoleImplementation -> error "legacy transition reached version-2 verification generation"+  ]+    <> ["  ]"]+  where+    entries =+      [ (source, edgeIndex, transitionIndex, transition)+      | (source, transitions) <- groupTransitionLayoutBySource (transitionLayout ((.transitions) aggregate)),+        entry <- transitions,+        let edgeIndex = (.outgoingIndex) entry+            transitionIndex = (.declarationIndex) entry+            transition = (.transition) entry+      ]++foldFingerprintExpression :: Agg -> Text+foldFingerprintExpression aggregate = case holeVersions of+  [] -> tshow ((.foldFingerprint) aggregate)+  _ ->+    "T.intercalate \"|\" ("+      <> tshow ((.foldFingerprint) aggregate)+      <> " : [foldToken "+      <> T.intercalate ", foldToken " holeVersions+      <> "] ) where foldToken (FoldVersion token) = T.pack (show (T.length token)) <> \":\" <> token"+  where+    holeVersions =+      [ "Holes." <> holeFoldVersionName index transition+      | (index, transition) <- transitionEntries aggregate,+        (.implementation) transition == HoleImplementation+      ]++groupTransitionEntriesBySource :: Agg -> [(Text, [(Int, Transition)])]+groupTransitionEntriesBySource aggregate =+  [ ( source,+      [((.declarationIndex) entry, (.transition) entry) | entry <- entries]+    )+  | (source, entries) <- groupTransitionLayoutBySource (transitionLayout ((.transitions) aggregate))+  ]++generatedFromBlock :: HaskellImportPlan -> Agg -> [ResolvedGeneratedTransition] -> (Text, [(Int, Transition)]) -> [Text]+generatedFromBlock importPlan aggregate resolvedTransitions (source, transitions) =+  ["    B.from " <> vertexCtor aggregate source <> " do"]+    ++ concatMap (uncurry (generatedOnCmdBlock importPlan aggregate resolvedTransitions)) transitions++generatedOnCmdBlock :: HaskellImportPlan -> Agg -> [ResolvedGeneratedTransition] -> Int -> Transition -> [Text]+generatedOnCmdBlock importPlan aggregate resolvedTransitions index transition =+  ["      B.onCmd inCtor" <> (.command) transition <> " $ \\" <> payloadBinder <> " -> B.do"]+    ++ projectionBindingLines+    ++ ["        B.replayOnly" | (.mode) transition == TmReplayOnly]+    ++ generatedBehavior+    ++ outputLines+    ++ ["        B.noEmit" | null ((.emits) transition)]+    ++ ["        B.goto " <> vertexCtor aggregate ((.goto) transition)]+  where+    generatedBehavior = case (.implementation) transition of+      GeneratedImplementation ->+        maybe [] (renderGuardLines importPlan aliases aggregate transition) ((.guard) resolved)+          ++ [ "        B.slot @" <> tshow registerName <> " =: " <> renderAssignmentOperand (renderKeikiTerm importPlan aliases aggregate transition expression)+             | (registerName, expression) <- (.writes) resolved+             ]+      HoleImplementation -> ["        Holes." <> holeFunctionName index transition <> " d"]+      LegacyHoleImplementation -> error "legacy transition reached version-2 transducer generation"+    resolved =+      fromMaybe+        (error ("resolved generated transition disappeared: " <> show index))+        (find ((== index) . (.index)) resolvedTransitions)+    aliases+      | (.implementation) transition == GeneratedImplementation = projectionAliasesForTransition resolved+      | otherwise = []+    projectionBindingLines = case aliases of+      [] -> []+      firstAlias : remainingAliases ->+        ["        let " <> renderProjectionAliasBinding importPlan aggregate transition firstAlias]+          <> ["            " <> renderProjectionAliasBinding importPlan aggregate transition alias | alias <- remainingAliases]+    outputLines =+      concat+        [ generatedOutputLines aggregate index transition emitIndex eventName+        | (emitIndex, eventName) <- zip [1 ..] ((.emits) transition)+        ]+    payloadBinder+      | payloadIsUsed = "d"+      | otherwise = "_d"+    payloadIsUsed = case (.implementation) transition of+      GeneratedImplementation ->+        isJust ((.guard) resolved)+          || not (null ((.writes) resolved))+          || any outputUsesPayload (zip [1 ..] ((.emits) transition))+      HoleImplementation -> True+      LegacyHoleImplementation -> True+    outputUsesPayload (emitIndex, _) = case outputMappingFor aggregate index emitIndex of+      GeneratedCommandIdentity _ fields -> not (null fields)+      HandOwnedEventOutput {} -> True++renderProjectionAliasBinding :: HaskellImportPlan -> Agg -> Transition -> ProjectionAlias -> Text+renderProjectionAliasBinding importPlan aggregate transition alias =+  (.name) alias <> " = " <> case (.target) alias of+    StructuralProjectionAlias provenance projection -> renderStructuralProjectionTerm importPlan aggregate transition provenance projection+    NominalProjectionAlias nominal provenance -> renderNominalProjectionTerm importPlan aggregate transition nominal provenance++renderGuardLines :: HaskellImportPlan -> [ProjectionAlias] -> Agg -> Transition -> TypedScalarExpr -> [Text]+renderGuardLines importPlan aliases aggregate transition expression =+  ["        B.requireGuard $"]+    <> ["          " <> line | line <- T.lines readable]+  where+    readable =+      T.replace " .|| " "\n.|| "+        . T.replace " .&& " "\n.&& "+        $ renderKeikiPredicate importPlan aliases aggregate transition expression++renderAssignmentOperand :: RenderedKeikiExpr -> Text+renderAssignmentOperand expression+  | (.precedence) expression <= 6 = "(" <> (.text) expression <> ")"+  | otherwise = (.text) expression++generatedOutputLines :: Agg -> Int -> Transition -> Int -> Name -> [Text]+generatedOutputLines aggregate transitionIndex transition emitIndex eventName =+  case outputMappingFor aggregate transitionIndex emitIndex of+    GeneratedCommandIdentity sourceCommand fields -> case fields of+      [] -> ["        B.emit wire" <> eventName <> " B.oNil"]+      _ ->+        [ "        B.emit wire" <> eventName <> " (" <> eventName <> "TermFields"+        ]+          <> [ lead fieldIndex+                 <> resolvedSelector sourceCommand field+                 <> " = d."+                 <> resolvedSelector sourceCommand field+             | (fieldIndex, field) <- zip [0 :: Int ..] fields+             ]+          <> ["          })"]+    HandOwnedEventOutput {} ->+      [ "        B.emit wire"+          <> eventName+          <> " (Holes."+          <> outputFunctionName transitionIndex transition emitIndex eventName+          <> " d)"+      ]+  where+    lead 0 = "          { "+    lead _ = "          , "+    resolvedSelector sourceCommand copiedField =+      commandFieldSelector aggregate sourceCommand ((.outputSelector) copiedField)++commandFieldSelector :: Agg -> Name -> Name -> Text+commandFieldSelector aggregate commandName dslFieldName =+  case [ (.selector) identity+       | command <- (.commands) aggregate,+         (.name) command == commandName,+         (identity, _) <- (.fields) command,+         (.dslName) identity == dslFieldName+       ] of+    selector : _ -> selector+    [] -> error "validated generated command-field selector was not found"++outputMappingFor :: Agg -> Int -> Int -> EventOutputMapping+outputMappingFor aggregate transitionIndex emitIndex =+  fromMaybe+    (error ("missing checked event-output mapping for transition " <> show transitionIndex <> ", emit " <> show emitIndex))+    (Map.lookup (transitionIndex, emitIndex) ((.outputMappings) aggregate))++--------------------------------------------------------------------------------+-- EventStream module+--------------------------------------------------------------------------------++emitEventStream :: Agg -> Text+emitEventStream a =+  nl $+    renderGeneratedLanguagePragmas [ExtOverloadedLabels | outcomeUsesLabels]+      ++ [ generatedBanner,+           "module " <> (.genPrefix) a <> ".EventStream",+           "  ( " <> lowerFirst ((.name) a) <> "Category",+           "  , " <> lowerFirst ((.name) a) <> "CommandCategory",+           "  , " <> lowerFirst ((.name) a) <> "EventStream",+           "  , " <> lowerFirst ((.name) a) <> "EventStreamDef",+           "  , " <> (.name) a <> "EventStream",+           "  , " <> (.name) a <> "EventStreamDef"+         ]+      ++ ["  , " <> lowerFirst ((.name) a) <> "SnapshotFixture" | hasSnapshot a]+      ++ ["  , " <> lowerFirst ((.name) a) <> "DomainCommandHandler" | outcomeEnabled]+      ++ [ "  ) where",+           "",+           "import " <> (.genPrefix) a <> ".Domain",+           "import " <> (.genPrefix) a <> ".Codec (" <> lowerFirst ((.name) a) <> "Codec)",+           transducerImport a+         ]+      ++ generatedOutcomeNominalImports+      ++ structuralProjectionImports+      ++ generatedNominalProjectionImports+      ++ consumerNominalProjectionImports+      ++ consumerImports+      ++ ["import Data.KindID qualified as KindID" | outcomeUsesConsumerIdLiteral]+      ++ ["import Keiro.Codec.Nominal (nominalFromRepresentation)" | outcomeUsesConsumerNominalLiteral]+      ++ ["import Keiki.Builder qualified as B" | outcomeUsesRegisterRoot]+      ++ [keikiCoreImport]+      ++ ["import Keiki.Core qualified as K" | outcomeEnabled]+      ++ ["import Keiki.Generics (RegFieldsOf)" | outcomeUsesCommandRoot]+      ++ ["import Keiro.Command (DomainCommandHandler (..), SilentCommandContext (..), SilentDomainDecision (..))" | outcomeEnabled]+      ++ [ "import Keiro.EventStream (EventStream (..), SnapshotPolicy (..))",+           "import Keiro.EventStream.Validate (ValidatedEventStream, mkEventStreamOrThrow)"+         ]+      ++ ["import Data.Text (Text)" | hasSnapshot a || outcomeUsesText]+      ++ ["import Data.Time.Calendar (fromGregorian)" | outcomeUsesTimeLiteral]+      ++ ["import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)" | outcomeUsesTimeLiteral]+      ++ ["import Data.Time.Clock (UTCTime)" | outcomeUsesTimeType && not outcomeUsesTimeLiteral]+      ++ ["import Numeric.Natural (Natural)" | outcomeUsesNaturalType]+      ++ ["import Keiro.Snapshot.Codec (defaultStateCodec, withFoldFingerprint)" | hasSnapshot a]+      ++ [ "import Keiro.Stream qualified as Stream",+           "",+           "-- The validated aggregate stream category (hole-kind 5: referenced, never retyped).",+           "-- Entity streams are '<category>-<id>' via Keiro.Stream.entityStream.",+           "-- categoryUnsafe is safe here because this generated literal passed the DSL category proof.",+           lowerFirst ((.name) a) <> "Category :: Stream.StreamCategory " <> (.name) a <> "EventStreamDef",+           lowerFirst ((.name) a) <> "Category = Stream.categoryUnsafe " <> tshow categoryName,+           "",+           "-- The same category text, typed for command envelopes such as PMCommand.",+           lowerFirst ((.name) a) <> "CommandCategory :: Stream.StreamCategory " <> (.name) a <> "Command",+           lowerFirst ((.name) a) <> "CommandCategory = Stream.categoryUnsafe " <> tshow categoryName,+           "",+           "type " <> (.name) a <> "EventStreamDef =",+           "  EventStream (HsPred " <> (.name) a <> "Regs " <> (.name) a <> "Command) " <> (.name) a <> "Regs " <> (.vertexType) a <> " " <> (.name) a <> "Command " <> (.name) a <> "Event",+           "",+           "type " <> (.name) a <> "EventStream =",+           "  ValidatedEventStream (HsPred " <> (.name) a <> "Regs " <> (.name) a <> "Command) " <> (.name) a <> "Regs " <> (.vertexType) a <> " " <> (.name) a <> "Command " <> (.name) a <> "Event",+           "",+           lowerFirst ((.name) a) <> "EventStreamDef :: " <> (.name) a <> "EventStreamDef",+           lowerFirst ((.name) a) <> "EventStreamDef =",+           "  EventStream",+           "    { transducer = " <> lowerFirst ((.name) a) <> "Transducer,",+           "      initialState = " <> initialVertex a <> ",",+           "      initialRegisters = initial" <> (.name) a <> "Regs,",+           "      eventCodec = " <> lowerFirst ((.name) a) <> "Codec,",+           "      resolveStreamName = Stream.streamName,",+           "      snapshotPolicy = " <> snapshotPolicyExpr a <> ","+         ]+      ++ stateCodecFieldLines a+      ++ [ "    }",+           ""+         ]+      ++ snapshotFixtureLines a+      ++ [ lowerFirst ((.name) a) <> "EventStream :: " <> (.name) a <> "EventStream",+           lowerFirst ((.name) a) <> "EventStream =",+           "  mkEventStreamOrThrow " <> tshow ((.name) a) <> " " <> lowerFirst ((.name) a) <> "EventStreamDef"+         ]+      ++ outcomeHandlerLines importPlan a silentOutcomes+  where+    categoryName = staticCategory ("aggregate " <> (.name) a) (lowerFirst ((.name) a))+    outcomeEnabled = isJust ((.domainOutcomeTypes) a)+    silentOutcomes = resolvedSilentOutcomes a+    outcomeExpressions = map (.reason) silentOutcomes+    outcomeResultTypes = case (.domainOutcomeTypes) a of+      Nothing -> []+      Just outcomeTypes -> [(.rejectionType) outcomeTypes, (.noOpType) outcomeTypes]+    outcomeImportTypes =+      nub+        ( outcomeResultTypes+            <> concatMap typedExpressionImportTypes outcomeExpressions+            <> concatMap typedExpressionLiteralTypes outcomeExpressions+        )+    consumerLiteralNominals = nub [nominal | expression <- outcomeExpressions, nominal <- typedConsumerLiteralNominals expression]+    importPlan = eventStreamImportPlan a outcomeImportTypes consumerLiteralNominals+    consumerImports = T.lines (renderPlannedImports importPlan)+    generatedOutcomeNominals =+      stableNominals+        ( generatedNominalsInTypes outcomeResultTypes+            <> [nominal | expression <- outcomeExpressions, nominal <- typedGeneratedNominals expression]+        )+    generatedLiteralNominals =+      stableNominals+        [ nominal+        | expression <- outcomeExpressions,+          literal <- typedExpressionLiterals expression,+          nominal <- typedGeneratedNominals literal+        ]+    generatedOutcomeNominalImports =+      generatedNominalTypeImportsWithParsers+        (aggregateCheckedService a)+        ((.context) a)+        generatedOutcomeNominals+        generatedLiteralNominals+    projectionTargets = nub (concatMap projectionAliasTargets outcomeExpressions)+    structuralProjectionImports =+      [ "import " <> structuralProjectionModule ((.context) a) <> " qualified as StructuralProjections"+      | any isStructuralProjection projectionTargets+      ]+    generatedNominalProjectionImports =+      [ "import " <> generatedNominalModule ((.context) a) <> " qualified as GeneratedNominals"+      | any isGeneratedNominalProjection projectionTargets+      ]+    consumerNominalProjectionImports =+      [ "import " <> nominalProjectionModule ((.context) a) <> " qualified as NominalProjections"+      | any isConsumerNominalProjection projectionTargets+      ]+    outcomeUsesRegisterRoot = any (anyTypedExpression usesRegisterRoot) outcomeExpressions+    outcomeUsesCommandRoot = any (anyTypedExpression usesCommandRoot) outcomeExpressions+    outcomeUsesLabels = outcomeUsesCommandRoot || not (null projectionTargets)+    outcomeUsesText =+      AggregateText `elem` outcomeImportTypes+        || any (anyTypedExpression isTextLiteral) outcomeExpressions+        || any isNominalProjection projectionTargets+    outcomeUsesTimeLiteral = any (anyTypedExpression isTimeLiteral) outcomeExpressions+    outcomeUsesTimeType = AggregateTime `elem` outcomeImportTypes+    outcomeUsesNaturalType = AggregateNatural `elem` outcomeImportTypes+    outcomeUsesConsumerNominalLiteral = not (null consumerLiteralNominals)+    outcomeUsesConsumerIdLiteral = any (isIdRepresentation . (.representation)) consumerLiteralNominals+    usedOperators = nub (concatMap outcomeExpressionOperators outcomeExpressions)+    keikiCoreImport+      | not outcomeEnabled = "import Keiki.Core (HsPred)"+      | otherwise =+          "import Keiki.Core (EdgeRef (..), HsPred"+            <> T.concat [", (" <> operator <> ")" | operator <- expressionOperatorOrder, operator `elem` usedOperators]+            <> ")"+    usesRegisterRoot expression = case (.node) expression of+      TypedRoot ScalarRegisterRoot {} -> True+      TypedProject provenance _ -> case provenance of+        ScalarRegisterRoot {} -> True+        ScalarCommandRoot {} -> False+      _ -> False+    usesCommandRoot expression = case (.node) expression of+      TypedRoot ScalarCommandRoot {} -> True+      TypedProject provenance _ -> case provenance of+        ScalarCommandRoot {} -> True+        ScalarRegisterRoot {} -> False+      _ -> False+    isTextLiteral expression = case (.node) expression of+      TypedLiteral ScalarTextValue {} -> True+      _ -> False+    isTimeLiteral expression = case (.node) expression of+      TypedLiteral ScalarTimeValue {} -> True+      _ -> False+    isNominalProjection NominalProjectionAlias {} = True+    isNominalProjection StructuralProjectionAlias {} = False+    isIdRepresentation IdRepresentation {} = True+    isIdRepresentation _ = False++outcomeHandlerLines :: HaskellImportPlan -> Agg -> [ResolvedSilentOutcome] -> [Text]+outcomeHandlerLines importPlan aggregate silentOutcomes = case (.domainOutcomeTypes) aggregate of+  Nothing -> []+  Just outcomeTypes ->+    [ "",+      handlerName,+      "  :: DomainCommandHandler",+      "       (HsPred " <> (.name) aggregate <> "Regs " <> (.name) aggregate <> "Command)",+      "       " <> (.name) aggregate <> "Regs",+      "       " <> (.vertexType) aggregate,+      "       " <> (.name) aggregate <> "Command",+      "       " <> (.name) aggregate <> "Event",+      "       " <> renderDomainType importPlan aggregate ((.rejectionType) outcomeTypes),+      "       " <> renderDomainType importPlan aggregate ((.noOpType) outcomeTypes),+      handlerName <> " =",+      "  DomainCommandHandler " <> lowerFirst ((.name) aggregate) <> "EventStream " <> classifierName,+      "",+      classifierName,+      "  :: SilentCommandContext " <> (.name) aggregate <> "Regs " <> (.vertexType) aggregate <> " " <> (.name) aggregate <> "Command",+      "  -> SilentDomainDecision",+      "       " <> renderDomainType importPlan aggregate ((.rejectionType) outcomeTypes),+      "       " <> renderDomainType importPlan aggregate ((.noOpType) outcomeTypes),+      classifierName <> " (SilentCommandContext _ registers command (EdgeRef edgeSource edgeIndex)) =",+      "  case edgeSource of"+    ]+      ++ concatMap renderSourceGroup sourceGroups+      ++ [ "    _ -> outcomeInvariant edgeSource edgeIndex",+           " where",+           "  outcomeInvariant source index =",+           "    error ("+             <> tshow ("generated domain outcome invariant failed for aggregate " <> (.name) aggregate <> " edge ")+             <> " <> show source <> \"#\" <> show index)"+         ]+  where+    handlerName = lowerFirst ((.name) aggregate) <> "DomainCommandHandler"+    classifierName = lowerFirst ((.name) aggregate) <> "SilentDecision"+    sourceGroups =+      [ (source, filter ((== source) . (.source) . (.transition) . (.layout)) silentOutcomes)+      | source <- nub (map ((.source) . (.transition) . (.layout)) silentOutcomes)+      ]+    renderSourceGroup (source, outcomes) =+      [ "    " <> vertexCtor aggregate source <> " ->",+        "      case edgeIndex of"+      ]+        ++ map renderArm outcomes+        ++ ["        _ -> outcomeInvariant edgeSource edgeIndex"]+    renderArm outcome =+      let entry = (.layout) outcome+          transition = (.transition) entry+          constructor = case (.kind) outcome of+            RejectedOutcome -> "SilentRejected"+            NoOpOutcome -> "SilentNoOp"+       in "        "+            <> tshow' ((.outgoingIndex) entry)+            <> " -> "+            <> constructor+            <> " ("+            <> renderOutcomeReasonEvaluation importPlan aggregate transition ((.reason) outcome)+            <> ")"++eventStreamImportPlan :: Agg -> [ResolvedAggregateType] -> [ResolvedNominalType] -> HaskellImportPlan+eventStreamImportPlan aggregate importedTypes literalNominals =+  planImportsOrDie+    ((.genPrefix) aggregate <> ".EventStream")+    localDeclarations+    ( Set.unions+        [ aggregateSourceReferences (aggregateConsumerHaskellSource ((.symbols) aggregate) resolvedType)+        | resolvedType <- importedTypes+        ]+        <> Set.fromList+          [ reference+          | nominal <- literalNominals,+            ConsumerNominal binding <- [(.ownership) nominal],+            reference <-+              qualifiedValueReference ((.binding) binding)+                : case (.representation) nominal of+                  EnumRepresentation constructors ->+                    [ nominalRepresentationConstructorReference ((.context) aggregate) nominal constructor+                    | (constructor, _) <- NE.toList constructors+                    ]+                  _ -> []+          ]+    )+  where+    localDeclarations =+      Set.fromList+        ( [ (.vertexType) aggregate,+            (.name) aggregate <> "Command",+            (.name) aggregate <> "Event",+            (.name) aggregate <> "Regs",+            (.name) aggregate <> "EventStream",+            (.name) aggregate <> "EventStreamDef"+          ]+            <> map (.name) ((.generatedNominals) aggregate)+            <> [ (.name) nominal+               | resolvedType <- importedTypes,+                 AggregateNominal nominal <- [resolvedType],+                 GeneratedNominal <- [(.ownership) nominal]+               ]+        )++snapshotPolicyExpr :: Agg -> Text+snapshotPolicyExpr aggregate = case (.snapshot) aggregate of+  Nothing -> "Never"+  Just snapshot -> case (.policy) snapshot of+    SnapEvery interval -> "Every " <> tshow' interval+    SnapOnTerminal -> "OnTerminal"++stateCodecExpr :: Agg -> Text+stateCodecExpr aggregate = case (.snapshot) aggregate of+  Nothing -> "Nothing"+  Just snapshot ->+    "Just (withFoldFingerprint "+      <> foldFingerprintValue aggregate+      <> " (defaultStateCodec "+      <> tshow' ((.codecVersion) snapshot)+      <> "))"++transducerImport :: Agg -> Text+transducerImport aggregate+  | hasVersion2Ownership aggregate =+      "import "+        <> (.genPrefix) aggregate+        <> ".Transducer ("+        <> (if hasSnapshot aggregate then lowerFirst ((.name) aggregate) <> "FoldFingerprint, " else "")+        <> lowerFirst ((.name) aggregate)+        <> "Transducer)"+  | otherwise =+      "import "+        <> (.holePrefix) aggregate+        <> ".Holes ("+        <> lowerFirst ((.name) aggregate)+        <> "Transducer)"++foldFingerprintValue :: Agg -> Text+foldFingerprintValue aggregate+  | hasVersion2Ownership aggregate = lowerFirst ((.name) aggregate) <> "FoldFingerprint"+  | otherwise = tshow ((.foldFingerprint) aggregate)++stateCodecFieldLines :: Agg -> [Text]+stateCodecFieldLines aggregate = case (.snapshot) aggregate of+  Nothing -> ["      stateCodec = Nothing"]+  Just _+    | hasVersion2Ownership aggregate ->+        [ "      -- The snapshot discriminator composes: the spec's state-codec version (bump it",+          "      -- in the spec's `state-codec version=` clause), keiki's register and",+          "      -- control-state shape hashes, and this fold fingerprint derived from the",+          "      -- spec's transition surface (guards, writes, emits, states, register",+          "      -- initials, referenced rules). Spec-visible fold changes invalidate old",+          "      -- snapshots automatically. Version-2 Hole-owned transitions additionally",+          "      -- compose their explicit hand-owned FoldVersion tokens here; bump the",+          "      -- corresponding token whenever that Hole behavior changes.",+          "      stateCodec = " <> stateCodecExpr aggregate+        ]+    | otherwise ->+        [ "      -- The snapshot discriminator composes: the spec's state-codec version (bump it",+          "      -- in the spec's `state-codec version=` clause), keiki's register and",+          "      -- control-state shape hashes, and this fold fingerprint derived from the",+          "      -- spec's transition surface (guards, writes, emits, states, register",+          "      -- initials, referenced rules). Spec-visible fold changes invalidate old",+          "      -- snapshots automatically. Fold changes made ONLY in the hand-owned Holes",+          "      -- module are invisible here: bump `state-codec version=` manually or old",+          "      -- snapshots will be served stale.",+          "      stateCodec = " <> stateCodecExpr aggregate+        ]++snapshotFixtureLines :: Agg -> [Text]+snapshotFixtureLines aggregate = case (.snapshot) aggregate of+  Nothing -> []+  Just snapshot ->+    [ lowerFirst ((.name) aggregate) <> "SnapshotFixture :: (Int, Text)",+      lowerFirst ((.name) aggregate) <> "SnapshotFixture = (" <> tshow' ((.codecVersion) snapshot) <> ", " <> tshow ((.shapeHash) snapshot) <> ")",+      ""+    ]++--------------------------------------------------------------------------------+-- Projection module+--------------------------------------------------------------------------------++emitProjection :: Agg -> Text+emitProjection a = case (.projection) a of+  Nothing ->+    nl+      ( renderGeneratedLanguagePragmas []+          <> [ generatedBanner,+               "module " <> (.genPrefix) a <> ".Projection () where",+               "",+               "-- No projection declarations are present; this module keeps the generated manifest inventory total."+             ]+      )+  Just p ->+    nl+      [ generatedBanner,+        "module " <> (.genPrefix) a <> ".Projection",+        "  ( " <> lowerFirst ((.table) p) <> "Projection",+        "  , " <> lowerFirst ((.table) p) <> "StatusFor",+        "  ) where",+        "",+        "import " <> (.genPrefix) a <> ".Domain",+        "import " <> (.holePrefix) a <> ".Holes (apply" <> pascal ((.table) p) <> ")",+        "import Data.Text (Text)",+        "import Keiro.Projection (InlineProjection (..))",+        "",+        "-- The deterministic event->status mapping (hole-kind 3, /mapping/), derived",+        "-- from the spec's status-map. The read-model SQL that consumes it lives in",+        "-- the hand-owned Holes module (a DB-coupled hole, delegated to codd).",+        projectionTableComment a p,+        lowerFirst ((.table) p) <> "StatusFor :: " <> (.name) a <> "Event -> Maybe Text",+        lowerFirst ((.table) p) <> "StatusFor = \\case",+        nl (statusArms a p),+        "",+        lowerFirst ((.table) p) <> "Projection :: InlineProjection " <> (.name) a <> "Event",+        lowerFirst ((.table) p) <> "Projection =",+        "  InlineProjection",+        "    { name = " <> tshow (contextNameToProjName a p),+        "    , apply = apply" <> pascal ((.table) p),+        "    }"+      ]++statusArms :: Agg -> ProjectionSpec -> [Text]+statusArms a p =+  [ "  " <> (.name) e <> " {} -> " <> statusFor e+  | e <- (.events) a+  ]+    ++ ["  _ -> Nothing" | hasWildcard]+  where+    pairs = maybe [] (.pairs) ((.statusMap) p)+    statusFor e = case lookup ((.name) e) pairs of+      Just value -> "Just " <> tshow value+      Nothing -> "Nothing"+    -- A wildcard is only needed if some event is uncovered; otherwise every arm+    -- is explicit and a wildcard would be redundant (and -Wall would warn).+    hasWildcard = False++contextNameToProjName :: Agg -> ProjectionSpec -> Text+contextNameToProjName a p = contextKebab a <> "-" <> (.table) p <> "-inline"++contextKebab :: Agg -> Text+contextKebab = kebabFromPascal . (.ctxPascal)++projectionReadModel :: Agg -> Maybe ReadModelNode+projectionReadModel aggregate = do+  projection <- (.projection) aggregate+  find ((== (.table) projection) . (.name)) ((.readModels) aggregate)++projectionTableComment :: Agg -> ProjectionSpec -> Text+projectionTableComment aggregate projection = case projectionReadModel aggregate of+  Nothing ->+    "-- WARNING: no readmodel node declares '"+      <> (.table) projection+      <> "'; unqualified SQL depends on search_path."+  Just readModel ->+    "-- Qualified table "+      <> qualifiedTableLiteral readModel+      <> "; use "+      <> genPrefixFor ((.context) aggregate) (pascal ((.name) readModel))+      <> ".ReadModelTable."+      <> readModelStem readModel+      <> "QualifiedTable."++--------------------------------------------------------------------------------+-- Holes module (create-if-absent)+--------------------------------------------------------------------------------++emitHoles :: Agg -> Text+emitHoles aggregate+  | hasVersion2Ownership aggregate = emitVersion2Holes aggregate+  | otherwise = emitLegacyHoles aggregate++emitLegacyHoles :: Agg -> Text+emitLegacyHoles a =+  nl+    [ "{-# LANGUAGE BlockArguments #-}",+      "{-# LANGUAGE DataKinds #-}",+      "{-# LANGUAGE OverloadedRecordDot #-}",+      "{-# LANGUAGE QualifiedDo #-}",+      "{-# LANGUAGE TypeApplications #-}",+      "-- This is a HAND-OWNED hole module. keiro-dsl creates it once and never",+      "-- overwrites it. Fill the transducer body (and any other holes) against the",+      "-- generated signatures, then run the harness to confirm behaviour.",+      "module " <> (.holePrefix) a <> ".Holes",+      "  ( " <> lowerFirst ((.name) a) <> "Transducer",+      holeProjectionExport a,+      holeUpcasterExports a,+      "  ) where",+      "",+      "import " <> (.genPrefix) a <> ".Domain",+      "import Keiki.Builder ((=:))",+      "import qualified Keiki.Builder as B",+      "import Keiki.Core (HsPred, RegFile, SymTransducer, lit, (.==), (./=), (.||))",+      holeUpcasterImports a,+      holeProjectionImports a,+      "",+      "-- HOLE: the transducer body. Reproduce the structure below, replacing each",+      "-- `-- HOLE` line with the keiki symbolic operators it describes.",+      lowerFirst ((.name) a) <> "Transducer",+      "  :: SymTransducer",+      "       (HsPred " <> (.name) a <> "Regs " <> (.name) a <> "Command)",+      "       " <> (.name) a <> "Regs",+      "       " <> (.vertexType) a,+      "       " <> (.name) a <> "Command",+      "       " <> (.name) a <> "Event",+      lowerFirst ((.name) a) <> "Transducer =",+      "  B.buildTransducer " <> initialVertex a <> " initial" <> (.name) a <> "Regs isTerminal do",+      nl (concatMap (fromBlock a) (groupBySource a)),+      " where",+      "  isTerminal = \\case",+      nl ["    " <> vertexCtor a ((.name) s) <> " -> True" | s <- (.states) a, (.terminal) s],+      "    _ -> False",+      holeProjectionStub a,+      holeUpcasterStubs a+    ]++emitVersion2Holes :: Agg -> Text+emitVersion2Holes aggregate =+  nl $+    [ "{-# LANGUAGE BlockArguments #-}",+      "{-# LANGUAGE DataKinds #-}",+      "{-# LANGUAGE DuplicateRecordFields #-}",+      "{-# LANGUAGE OverloadedRecordDot #-}",+      "{-# LANGUAGE QualifiedDo #-}",+      "{-# LANGUAGE TypeApplications #-}",+      "-- This is a HAND-OWNED version-2 hook module. keiro-dsl creates it once",+      "-- and never overwrites it. Generated code owns every transition envelope",+      "-- and every declared guard/write. This module supplies explicit event-field",+      "-- mappings and explicitly selected Hole behavior only; fields(Command)",+      "-- identity mappings are generated directly and have no hook."+    ]+      ++ version2HoleModuleDeclaration aggregate+      ++ [ "",+           "import " <> (.genPrefix) aggregate <> ".Domain",+           "import Keiki.Builder qualified as B",+           "import Keiki.Generics (RegFieldsOf)",+           holeUpcasterImports aggregate,+           holeProjectionImports aggregate+         ]+      ++ ["import Keiki.Core qualified as K" | anyHoleOwned aggregate || anyZeroFieldOutput aggregate]+      ++ ["import Keiro.Snapshot.Codec (FoldVersion (..))" | anyHoleOwned aggregate]+      ++ concatMap (uncurry (emitOutputHooks aggregate)) (transitionEntries aggregate)+      ++ concatMap (uncurry (emitHoleImplementation aggregate)) (transitionEntries aggregate)+      ++ [holeProjectionStub aggregate, holeUpcasterStubs aggregate]++anyZeroFieldOutput :: Agg -> Bool+anyZeroFieldOutput aggregate =+  or+    [ isHandOwned (outputMappingFor aggregate transitionIndex emitIndex)+        && null ((.fields) (eventForName aggregate eventName))+    | (transitionIndex, transition) <- transitionEntries aggregate,+      (emitIndex, eventName) <- zip [1 ..] ((.emits) transition)+    ]+  where+    isHandOwned HandOwnedEventOutput {} = True+    isHandOwned GeneratedCommandIdentity {} = False++version2HoleModuleDeclaration :: Agg -> [Text]+version2HoleModuleDeclaration aggregate = case version2HoleExports aggregate of+  [] -> ["module " <> (.holePrefix) aggregate <> ".Holes () where"]+  firstExport : rest ->+    [ "module " <> (.holePrefix) aggregate <> ".Holes",+      "  ( " <> firstExport+    ]+      ++ ["  , " <> value | value <- rest]+      ++ ["  ) where"]++version2HoleExports :: Agg -> [Text]+version2HoleExports aggregate =+  outputExports+    <> holeExports+    <> projectionExports+    <> [functionName | (_, _, functionName) <- upcasterEntries aggregate]+  where+    outputExports =+      [ outputFunctionName transitionIndex transition emitIndex eventName+      | (transitionIndex, transition) <- transitionEntries aggregate,+        (emitIndex, eventName) <- zip [1 ..] ((.emits) transition),+        HandOwnedEventOutput {} <- [outputMappingFor aggregate transitionIndex emitIndex]+      ]+    holeExports =+      concat+        [ [holeFunctionName index transition, holeFoldVersionName index transition]+        | (index, transition) <- transitionEntries aggregate,+          (.implementation) transition == HoleImplementation+        ]+    projectionExports = case (.projection) aggregate of+      Nothing -> []+      Just projection -> ["apply" <> pascal ((.table) projection)]++emitOutputHooks :: Agg -> Int -> Transition -> [Text]+emitOutputHooks aggregate transitionIndex transition =+  concat+    [ emitOutputHook aggregate transitionIndex transition emitIndex (eventForName aggregate eventName)+    | (emitIndex, eventName) <- zip [1 ..] ((.emits) transition),+      HandOwnedEventOutput {} <- [outputMappingFor aggregate transitionIndex emitIndex]+    ]++emitOutputHook :: Agg -> Int -> Transition -> Int -> ResolvedCtor -> [Text]+emitOutputHook aggregate transitionIndex transition emitIndex event =+  [ "",+    "-- Hand-owned event-field hook inside the generated transition envelope.",+    functionName+      <> " :: "+      <> payloadProjectionType aggregate transition+      <> " -> "+      <> outputType,+    functionName <> " d = " <> outputValue+  ]+  where+    functionName = outputFunctionName transitionIndex transition emitIndex ((.name) event)+    inputFields = "(" <> commandFieldsType transition <> ")"+    outputType+      | null ((.fields) event) =+          "K.OutFields "+            <> (.name) aggregate+            <> "Regs "+            <> (.name) aggregate+            <> "Command "+            <> inputFields+            <> " ()"+      | otherwise =+          (.name) event+            <> "TermFields "+            <> (.name) aggregate+            <> "Regs "+            <> (.name) aggregate+            <> "Command "+            <> inputFields+    outputValue+      | null ((.fields) event) = "B.oNil"+      | otherwise =+          (.name) event+            <> "TermFields\n"+            <> nl+              ( valueRecord+                  [ ((.selector) identity, outputFieldValue identity valueType)+                  | (identity, valueType) <- (.fields) event+                  ]+              )+    command = commandForTransition aggregate transition+    outputFieldValue identity valueType+      | Just (commandIdentity, commandType) <- find ((== (.dslName) identity) . (.dslName) . fst) ((.fields) command),+        commandType == valueType =+          "d." <> (.selector) commandIdentity+      | Just register <- find ((== (.dslName) identity) . (.name)) ((.regs) aggregate),+        (.valueType) register == valueType =+          "B.reg @" <> tshow ((.dslName) identity)+      | otherwise = "error " <> tshow ("HOLE: fill output field " <> (.name) event <> "." <> (.dslName) identity)+    valueRecord fields =+      [ lead fieldIndex <> name <> " = " <> fieldValue+      | (fieldIndex, (name, fieldValue)) <- zip [0 :: Int ..] fields+      ]+        ++ ["  }"]+    lead 0 = "  { "+    lead _ = "  , "++emitHoleImplementation :: Agg -> Int -> Transition -> [Text]+emitHoleImplementation aggregate index transition+  | (.implementation) transition /= HoleImplementation = []+  | otherwise =+      [ "",+        "-- HOLE: add the predicate and ordered register updates for this transition.",+        "-- The generated transducer still owns command matching, mode, emits, and goto.",+        holeFunctionName index transition+          <> " :: "+          <> payloadProjectionType aggregate transition+          <> " -> B.EdgeBuilder "+          <> (.name) aggregate+          <> "Regs "+          <> (.name) aggregate+          <> "Command "+          <> (.name) aggregate+          <> "Event "+          <> (.vertexType) aggregate+          <> " ('Just ("+          <> commandFieldsType transition+          <> ")) writes writes ()",+        holeFunctionName index transition <> " _d = B.requireGuard K.PTop",+        "",+        "-- Bump this token whenever the Hole predicate or updates change.",+        holeFoldVersionName index transition <> " :: FoldVersion",+        holeFoldVersionName index transition <> " = FoldVersion " <> tshow (transitionStem index transition <> "-fold-v1")+      ]++-- | Export, import, and stub the per-event upcaster holes (EP-2 evolution).+holeUpcasterExports :: Agg -> Text+holeUpcasterExports a = case upcasterEntries a of+  [] -> ""+  es -> nl ["  , " <> fn | (_, _, fn) <- es]++holeUpcasterImports :: Agg -> Text+holeUpcasterImports a = case upcasterEntries a of+  [] -> ""+  _ -> nl ["import Data.Aeson (Value)", "import Data.Text (Text)"]++holeUpcasterStubs :: Agg -> Text+holeUpcasterStubs a = case upcasterEntries a of+  [] -> ""+  es ->+    nl $+      concat+        [ [ "",+            "-- HOLE upcaster: this hole receives ONLY " <> eventName <> " payloads stored at",+            "-- aggregate schema version " <> tshow' source <> "; other event kinds pass through the",+            "-- generated rung dispatch automatically. Bring this payload up one version and decide",+            "-- the default/derivation for any field added at the new version here.",+            fn <> " :: Value -> Either Text Value",+            fn <> " _ = Left \"HOLE: upcaster not implemented\""+          ]+        | (source, eventName, fn) <- es+        ]++holeProjectionExport :: Agg -> Text+holeProjectionExport a = case (.projection) a of+  Nothing -> "  -- (no projection)"+  Just p -> "  , apply" <> pascal ((.table) p)++holeProjectionImports :: Agg -> Text+holeProjectionImports aggregate = case projectionReadModel aggregate of+  Nothing -> ""+  Just readModel ->+    "import "+      <> genPrefixFor ((.context) aggregate) (pascal ((.name) readModel))+      <> ".ReadModelTable ("+      <> readModelStem readModel+      <> "QualifiedTable)"++holeProjectionStub :: Agg -> Text+holeProjectionStub a = case (.projection) a of+  Nothing -> ""+  Just p ->+    nl+      ( [ "",+          "-- HOLE: the read-model SQL for the projection (a DB-coupled hole; the",+          "-- pure event->status mapping is generated as " <> lowerFirst ((.table) p) <> "StatusFor)."+        ]+          ++ projectionGuidance+          ++ [ "apply" <> pascal ((.table) p) <> " :: " <> (.name) a <> "Event -> recorded -> txn ()",+               "apply" <> pascal ((.table) p) <> " _event _recorded = " <> projectionTableUse <> "error \"HOLE: fill " <> (.table) p <> " projection apply\""+             ]+      )+    where+      projectionGuidance = case projectionReadModel a of+        Nothing ->+          ["-- WARNING: no readmodel node declares this table's schema; unqualified SQL depends on search_path."]+        Just readModel ->+          [ "-- Table: " <> qualifiedTableLiteral readModel <> ". Use " <> readModelStem readModel <> "QualifiedTable; never rely on search_path.",+            "-- Declared columns:"+          ]+            ++ map (("--   " <>) . readModelColumnDoc) ((.columns) readModel)+      projectionTableUse = case projectionReadModel a of+        Nothing -> ""+        Just readModel -> readModelStem readModel <> "QualifiedTable `seq` "++-- Group transitions by source state, preserving order, for the B.from blocks.+groupBySource :: Agg -> [(Text, [Transition])]+groupBySource a =+  [ (source, map (.transition) entries)+  | (source, entries) <- groupTransitionLayoutBySource (transitionLayout (transitionsOf a))+  ]++-- We don't keep the original Aggregate around in Agg, so reconstruct+-- transitions from a stored field. (Filled in resolveAgg via aTransitions.)+transitionsOf :: Agg -> [Transition]+transitionsOf = (.transitions)++fromBlock :: Agg -> (Text, [Transition]) -> [Text]+fromBlock a (src, ts) =+  [ "    B.from " <> vertexCtor a src <> " do"+  ]+    ++ concatMap (onCmdBlock a) ts++onCmdBlock :: Agg -> Transition -> [Text]+onCmdBlock a t =+  [ "      B.onCmd inCtor" <> (.command) t <> " $ \\d -> B.do"+  ]+    -- Plan 143: the mode is structural, not hole-owned — a replay-only+    -- transition lowers to B.replayOnly (keiki ReplayOnly edge).+    ++ ["        B.replayOnly" | (.mode) t == TmReplayOnly]+    ++ maybe [] (\g -> ["        -- HOLE guard: " <> renderGuard g]) ((.guard) t)+    ++ ["        -- HOLE write " <> r <> " := " <> renderGuard e | (r, e) <- (.writes) t]+    ++ ["        -- HOLE emit " <> ev <> " (B.emit wire" <> ev <> " ...)" | ev <- (.emits) t]+    ++ ["        B.goto " <> vertexCtor a ((.goto) t)]++--------------------------------------------------------------------------------+-- Field categories and shared helpers+--------------------------------------------------------------------------------++data FieldCat+  = IdCat+  | EnumCat+  | MappedStructuralCat !StructuralDecl !ResolvedMappedShape+  | MappedOpaqueCat !OpaqueDecl+  | OtherCat+  deriving stock (Eq, Show)++fieldCat :: Agg -> ResolvedAggregateType -> FieldCat+fieldCat a ty+  | AggregateNominal nominal <- ty,+    IdRepresentation {} <- (.representation) nominal =+      IdCat+  | AggregateNominal nominal <- ty,+    EnumRepresentation {} <- (.representation) nominal =+      EnumCat+  | Just (ResolvedStructural declaration shape) <- mappedDeclFor a ty = MappedStructuralCat declaration shape+  | Just (ResolvedOpaque declaration) <- mappedDeclFor a ty = MappedOpaqueCat declaration+  | otherwise = OtherCat++-- | The first constructor of a declared enum, used to build sample values.+firstEnumCtor :: Agg -> Text -> Maybe Text+firstEnumCtor a ty =+  case [c | e <- (.enums) a, (.name) e == ty, (c, _) <- take 1 ((.ctors) e)] of+    (c : _) -> Just c+    [] -> Nothing++vertexCtor :: Agg -> Text -> Text+vertexCtor a s = (.name) a <> s++initialVertex :: Agg -> Text+initialVertex a = case (.states) a of+  (s : _) -> vertexCtor a ((.name) s)+  [] -> (.name) a <> "Init"++generatedBanner :: Text+generatedBanner = "-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec."++-- | The provenance line written by a concrete scaffold plan. The package+-- version comes from Cabal's build metadata, while the language and origin come+-- from the checked semantic input and the emitted module respectively.+generatedBannerFor :: EffectiveLanguageContract -> Text -> Text+generatedBannerFor languageContract sourceOrigin =+  "-- @generated by keiro-dsl "+    <> T.pack (showVersion Package.version)+    <> " (language keiro-dsl "+    <> languageVersionText ((.contractLanguageVersion) languageContract)+    <> ") from "+    <> stableBannerOrigin sourceOrigin+    <> "; do not edit."++-- Source line numbers are useful refusal metadata but are not stable ownership:+-- moving an unchanged node within or between workspace members must not rewrite+-- every Generated file. The node kind and name remain the banner authority.+stableBannerOrigin :: Text -> Text+stableBannerOrigin sourceOrigin =+  case T.breakOnEnd " (line " withoutMemberPath of+    (prefixWithMarker, lineWithClose)+      | not (T.null prefixWithMarker),+        Just lineNumber <- T.stripSuffix ")" lineWithClose,+        not (T.null lineNumber),+        T.all isDigit lineNumber ->+          T.dropEnd (T.length " (line ") prefixWithMarker+    _ -> withoutMemberPath+  where+    withoutMemberPath = case T.breakOn ": " sourceOrigin of+      (path, attributedOrigin)+        | ".keiro" `T.isSuffixOf` path,+          not (T.null attributedOrigin) ->+            T.drop 2 attributedOrigin+      _ -> sourceOrigin++-- | Recognize the exact historical banner or the frozen stamped format. This+-- intentionally rejects arbitrary comments that merely start with+-- @-- \@generated@.+isGeneratedBannerLine :: Text -> Bool+isGeneratedBannerLine line =+  line == generatedBanner+    || ( stampedPrefix `T.isPrefixOf` line+           && " (language keiro-dsl " `T.isInfixOf` line+           && ") from " `T.isInfixOf` line+           && "; do not edit." `T.isSuffixOf` line+       )+  where+    stampedPrefix = "-- @generated by keiro-dsl "++-- | Replace an emitter's legacy placeholder (or an earlier stamp) with the+-- provenance for this plan. A Generated module with a specialized banner gets+-- the standard stamp prepended, so every planned Generated file is covered.+stampGeneratedModule :: EffectiveLanguageContract -> ScaffoldModule -> ScaffoldModule+stampGeneratedModule languageContract moduleValue+  | modernized.kind == HoleStub = modernized+  | otherwise = ScaffoldModule modernized.path stampedText modernized.kind modernized.origin+  where+    modernized = modernizeScaffoldModule moduleValue+    banner = generatedBannerFor languageContract modernized.origin+    sourceLines = T.splitOn "\n" modernized.text+    stampedText = case replaceFirstGeneratedBanner banner sourceLines of+      Nothing -> banner <> "\n" <> modernized.text+      Just linesWithStamp -> T.intercalate "\n" linesWithStamp++modernizeScaffoldModule :: ScaffoldModule -> ScaffoldModule+modernizeScaffoldModule (ScaffoldModule path source kind origin) =+  ScaffoldModule path (modernizeGeneratedHaskellSource source) kind origin++stampGeneratedModules :: EffectiveLanguageContract -> [ScaffoldModule] -> [ScaffoldModule]+stampGeneratedModules languageContract = map (stampGeneratedModule languageContract)++replaceFirstGeneratedBanner :: Text -> [Text] -> Maybe [Text]+replaceFirstGeneratedBanner _ [] = Nothing+replaceFirstGeneratedBanner replacement (line : rest)+  | isGeneratedBannerLine line = Just (replacement : rest)+  | otherwise = (line :) <$> replaceFirstGeneratedBanner replacement rest++nodeOrigin :: Text -> Text -> Loc -> Text+nodeOrigin nodeKind nodeName loc =+  nodeKind <> " " <> nodeName <> case unLoc loc of+    0 -> ""+    line -> " (line " <> tshow' line <> ")"++-- | Conditions that the deterministic emitters cannot lower faithfully. The+-- pre-write scaffold pipeline treats each returned message as a refusal. The+-- list is extended alongside the policy and type lowering milestones.+scaffoldRefusals :: Spec -> [Text]+scaffoldRefusals spec = scaffoldRefusalsWithSymbols (aggregateSymbols spec) spec++scaffoldRefusalsForService :: CheckedService -> [Text]+scaffoldRefusalsForService service =+  scaffoldRefusalsWithSymbols+    (aggregateSymbolsFromGraphResult (checkedTypeGraph service) spec)+    spec+  where+    spec = checkedSpec service++scaffoldRefusalsWithSymbols :: AggregateSymbols -> Spec -> [Text]+scaffoldRefusalsWithSymbols symbols spec =+  concatMap aggregateRefusals aggregates+    <> concatMap contractRefusals contracts+    <> concatMap publisherRefusals publishers+  where+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    contracts = [contract | NContract contract <- (.nodes) spec]+    publishers = [publisher | NPublisher publisher <- (.nodes) spec]+    aggregateRefusals aggregate =+      [ "AggregateEmpty: aggregate '" <> (.name) aggregate <> "' must declare at least one command, event, and transition"+      | null ((.commands) aggregate) || null ((.events) aggregate) || null ((.transitions) aggregate)+      ]+        <> concatMap (registerRefusals aggregate) ((.regs) aggregate)+        <> concatMap (fieldRefusals aggregate CommandFieldUse) (concatMap (.fields) ((.commands) aggregate))+        <> concatMap (fieldRefusals aggregate EventFieldUse) [field | event <- (.events) aggregate, EventFields fields <- [(.body) event], field <- fields]+    fieldRefusals aggregate useSite field = case inferAggregateFieldType symbols aggregate useSite field of+      Right _ -> []+      Left _ ->+        [ "FieldTypeUnrepresentable: aggregate '"+            <> (.name) aggregate+            <> "' field '"+            <> (.name) field+            <> "' has unsupported explicit type '"+            <> maybe "(inferred)" typeExprCanonicalName ((.valueType) field)+            <> "'"+        ]+    registerRefusals aggregate register =+      case resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register) of+        Left _ ->+          [ "RegTypeUnsupported: aggregate '"+              <> (.name) aggregate+              <> "' register '"+              <> (.name) register+              <> "' has unsupported type '"+              <> typeExprCanonicalName ((.valueType) register)+              <> "'"+          ]+        Right resolved -> case resolveRegisterInitial symbols ((.loc) register) resolved ((.initial) register) of+          Right _ -> []+          Left _ -> [initialRefusal aggregate register resolved]+    initialRefusal aggregate register resolved = case resolved of+      AggregateText -> label "RegTextInitialNotQuoted" "must use a quoted Text initial"+      AggregateNominal nominal+        | EnumRepresentation {} <- (.representation) nominal ->+            label "RegInitialNotEnumCtor" ("must start at the declaration-owned initial for enum '" <> (.name) nominal <> "'")+      AggregateMapped {} -> label "MappedRegisterInitialMissing" "requires the mapped declaration's initial symbol"+      _ -> label "RegInitialInvalidLiteral" ("has an invalid " <> aggregateCanonicalName resolved <> " initial")+      where+        label codeName detail = codeName <> ": aggregate '" <> (.name) aggregate <> "' register '" <> (.name) register <> "' " <> detail+    contractRefusals contract =+      [ "ContractEmpty: contract '" <> (.name) contract <> "' must declare at least one event"+      | null ((.events) contract)+      ]+    publisherRefusals publisher =+      let backoff = (.backoff) publisher+          label message = message <> ": publisher '" <> (.name) publisher <> "'"+       in case (.kind) backoff of+            "constant" -> []+            "exponential" -> case ((.max) backoff, (.multiplier) backoff) of+              (Just maximumWindow, Just multiplierText) ->+                case (windowSeconds ((.window) backoff), windowSeconds maximumWindow, readMaybe (T.unpack multiplierText) :: Maybe Double) of+                  (Right initialSeconds, Right maximumSeconds, Just multiplier)+                    | initialSeconds > 0 && maximumSeconds >= initialSeconds && multiplier >= 1 -> []+                  _ -> [label "BackoffInvalidExponential"]+              _ -> [label "BackoffExponentialIncomplete"]+            other -> [label ("BackoffUnknownKind '" <> other <> "'")]++windowSeconds :: Text -> Either Text Int+windowSeconds window = case T.unsnoc window of+  Just (digits, unit)+    | not (T.null digits),+      Just amount <- readMaybe (T.unpack digits) -> case unit of+        's' -> Right amount+        'm' -> Right (amount * 60)+        'h' -> Right (amount * 3600)+        _ -> Left invalid+  _ -> Left invalid+  where+    invalid = "invalid window '" <> window <> "' (expected digits followed by s, m, or h)"++windowText :: Text -> Text+windowText = either (const "0") tshow' . windowSeconds++-- | Render an Expr back to source-ish text for a hole annotation.+renderGuard :: Expr -> Text+renderGuard = renderExpr++--------------------------------------------------------------------------------+-- Text helpers+--------------------------------------------------------------------------------++nl :: [Text] -> Text+nl = T.intercalate "\n"++-- | Join groups of declarations, blank-line-separated, dropping empties.+sectionsOf :: [[Text]] -> Text+sectionsOf = T.intercalate "\n\n" . filter (not . T.null) . map (T.intercalate "\n\n")++lowerFirst :: Text -> Text+lowerFirst = generatedCase HaskellName.LogicalIdentifier False++-- | Assert the shared category proof at emission time as a belt-and-braces+-- guard for callers that bypass the CLI's normal validate-before-scaffold path.+staticCategory :: Text -> Text -> Text+staticCategory owner value = case sagaCategoryError value of+  Nothing -> value+  Just reason -> error (T.unpack ("keiro-dsl scaffold: illegal " <> owner <> " category " <> tshow value <> " " <> reason))++pascal :: Text -> Text+pascal = generatedCase HaskellName.LogicalIdentifier True++pascalFromKebab :: Text -> Text+pascalFromKebab = generatedCase HaskellName.LogicalWireWord True++generatedCase :: HaskellName.NameSourceKind -> Bool -> Text -> Text+generatedCase source upper name =+  case HaskellName.deriveHaskellName source site of+    Right derived+      | upper -> HaskellName.renderUpperCamelName ((.upperCamel) derived)+      | otherwise -> HaskellName.renderLowerCamelName ((.lowerCamel) derived)+    Left _ -> name+  where+    site =+      HaskellName.NameSite+        { HaskellName.kind = HaskellName.GeneratedHelperSite,+          HaskellName.logicalName = name,+          HaskellName.owner = "scaffold-renderer",+          HaskellName.line = 0         }  kebabFromPascal :: Text -> Text

src/Keiro/Dsl/ScaffoldRecord.hs view

@@ -39,45 +39,45 @@ import System.FilePath (isAbsolute, splitDirectories)  data ScaffoldRecord = ScaffoldRecord-  { recSpecPath :: !Text,-    recModuleRoot :: !Text,-    recLayout :: !Text,-    recSourceLanguage :: !SourceLanguage,-    recLanguageContract :: !EffectiveLanguageContract,-    recNamingEdition :: !GeneratedHaskellNamingEdition,-    recModuleRoles :: ![ScaffoldModuleRoleRow],-    recFiles :: ![(ModuleKind, FilePath)],-    recMappings :: ![MappingIdentity],-    recIdDomains :: ![Text],-    recNominalEqualities :: ![Text],-    recBindingObligations :: ![BindingHole],-    recBehaviorRequirements :: ![BehaviorRecordRow],-    recProjectionCatalogFacts :: ![Text],-    recQueryContractBaseline :: !Bool,-    recQueryContracts :: ![QueryContractIdentity],-    recRouterSelections :: ![RouterSelectionSnapshot],-    recSemanticImpact :: !(Maybe SemanticImpactSnapshot)+  { specPath :: !Text,+    moduleRoot :: !Text,+    layout :: !Text,+    sourceLanguage :: !SourceLanguage,+    languageContract :: !EffectiveLanguageContract,+    namingEdition :: !GeneratedHaskellNamingEdition,+    moduleRoles :: ![ScaffoldModuleRoleRow],+    files :: ![(ModuleKind, FilePath)],+    mappings :: ![MappingIdentity],+    idDomains :: ![Text],+    nominalEqualities :: ![Text],+    bindingObligations :: ![BindingHole],+    behaviorRequirements :: ![BehaviorRecordRow],+    projectionCatalogFacts :: ![Text],+    queryContractBaseline :: !Bool,+    queryContracts :: ![QueryContractIdentity],+    routerSelections :: ![RouterSelectionSnapshot],+    semanticImpact :: !(Maybe SemanticImpactSnapshot)   }   deriving stock (Eq, Show)  data ScaffoldModuleRoleRow = ScaffoldModuleRoleRow-  { srrRole :: !ModuleRole,-    srrKind :: !ModuleKind,-    srrPath :: !FilePath+  { role :: !ModuleRole,+    kind :: !ModuleKind,+    path :: !FilePath   }   deriving stock (Eq, Show)  instance Aeson.ToJSON ScaffoldModuleRoleRow where   toJSON row =     Aeson.object-      [ "ownerKind" .= roleOwnerKind role,-        "ownerName" .= roleOwnerName role,-        "family" .= roleFamily role,-        "kind" .= (case srrKind row of Generated -> "generated" :: Text; HoleStub -> "hole"),-        "path" .= T.pack (srrPath row)+      [ "ownerKind" .= (.ownerKind) role,+        "ownerName" .= (.ownerName) role,+        "family" .= (.family) role,+        "kind" .= (case (.kind) row of Generated -> "generated" :: Text; HoleStub -> "hole"),+        "path" .= T.pack ((.path) row)       ]     where-      role = srrRole row+      role = (.role) row  instance Aeson.FromJSON ScaffoldModuleRoleRow where   parseJSON = Aeson.withObject "ScaffoldModuleRoleRow" $ \fields -> do@@ -92,36 +92,36 @@     rowPath <- fields .: "path"     pure       ScaffoldModuleRoleRow-        { srrRole = ModuleRole ownerKind ownerName family,-          srrKind = rowKind,-          srrPath = T.unpack (rowPath :: Text)+        { role = ModuleRole ownerKind ownerName family,+          kind = rowKind,+          path = T.unpack (rowPath :: Text)         }  renderRecord :: ScaffoldRecord -> Text renderRecord record =   T.unlines $     [ "keiro-dsl scaffold record v1",-      "spec: " <> recSpecPath record,+      "spec: " <> (.specPath) record,       "module-root: " <> rootLabel,-      "layout: " <> recLayout record,-      "source-language " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode (recSourceLanguage record))),-      "semantic-contract " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode (recLanguageContract record))),-      "naming-edition " <> renderGeneratedHaskellNamingEdition (recNamingEdition record)+      "layout: " <> (.layout) record,+      "source-language " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode ((.sourceLanguage) record))),+      "semantic-contract " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode ((.languageContract) record))),+      "naming-edition " <> renderGeneratedHaskellNamingEdition ((.namingEdition) record)     ]-      <> map ("module-role " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) (recModuleRoles record))-      <> map renderFile (recFiles record)-      <> map renderMapping (recMappings record)-      <> map ("id-domain " <>) (recIdDomains record)-      <> map ("nominal-equality " <>) (recNominalEqualities record)-      <> map renderBindingObligation (recBindingObligations record)-      <> map renderBehaviorRequirement (recBehaviorRequirements record)-      <> map ("projection-catalog-fact " <>) (recProjectionCatalogFacts record)-      <> ["query-contract-baseline v1" | recQueryContractBaseline record]-      <> map ("query-contract " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) (recQueryContracts record))-      <> map ("router-selection " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) (recRouterSelections record))-      <> ["semantic-impact " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode snapshot)) | Just snapshot <- [recSemanticImpact record]]+      <> map ("module-role " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) ((.moduleRoles) record))+      <> map renderFile ((.files) record)+      <> map renderMapping ((.mappings) record)+      <> map ("id-domain " <>) ((.idDomains) record)+      <> map ("nominal-equality " <>) ((.nominalEqualities) record)+      <> map renderBindingObligation ((.bindingObligations) record)+      <> map renderBehaviorRequirement ((.behaviorRequirements) record)+      <> map ("projection-catalog-fact " <>) ((.projectionCatalogFacts) record)+      <> ["query-contract-baseline v1" | (.queryContractBaseline) record]+      <> map ("query-contract " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) ((.queryContracts) record))+      <> map ("router-selection " <>) (map (Text.decodeUtf8 . BL.toStrict . Aeson.encode) ((.routerSelections) record))+      <> ["semantic-impact " <> Text.decodeUtf8 (BL.toStrict (Aeson.encode snapshot)) | Just snapshot <- [(.semanticImpact) record]]   where-    rootLabel = if T.null (recModuleRoot record) then "(none)" else recModuleRoot record+    rootLabel = if T.null ((.moduleRoot) record) then "(none)" else (.moduleRoot) record     renderFile (Generated, path) = "generated " <> T.pack path     renderFile (HoleStub, path) = "hole " <> T.pack path     renderMapping mapping =@@ -158,29 +158,29 @@         queryContracts <- traverse parseQueryContract (filter ("query-contract " `T.isPrefixOf`) rows)         routerSelections <- traverse parseRouterSelection (filter ("router-selection " `T.isPrefixOf`) rows)         semanticImpact <- parseSemanticImpact rows-        if hasDuplicateMappingNames mappings || hasDuplicates idDomains || hasDuplicates nominalEqualities || hasDuplicateBindingObligations bindingEntries || hasDuplicateBehaviorRequirements behaviorEntries || hasDuplicates catalogFacts || hasDuplicates (map queryContractIdentityKey queryContracts) || hasDuplicates (map selectionRouter routerSelections)+        if hasDuplicateMappingNames mappings || hasDuplicates idDomains || hasDuplicates nominalEqualities || hasDuplicateBindingObligations bindingEntries || hasDuplicateBehaviorRequirements behaviorEntries || hasDuplicates catalogFacts || hasDuplicates (map queryContractIdentityKey queryContracts) || hasDuplicates (map (.router) routerSelections)           then Nothing           else             pure               ScaffoldRecord-                { recSpecPath = specPath,-                  recModuleRoot = if rootLabel == "(none)" then "" else rootLabel,-                  recLayout = layout,-                  recSourceLanguage = sourceLanguage,-                  recLanguageContract = languageContract,-                  recNamingEdition = namingEdition,-                  recModuleRoles = moduleRoles,-                  recFiles = files,-                  recMappings = mappings,-                  recIdDomains = idDomains,-                  recNominalEqualities = nominalEqualities,-                  recBindingObligations = bindingEntries,-                  recBehaviorRequirements = behaviorEntries,-                  recProjectionCatalogFacts = catalogFacts,-                  recQueryContractBaseline = queryContractBaseline,-                  recQueryContracts = queryContracts,-                  recRouterSelections = routerSelections,-                  recSemanticImpact = semanticImpact+                { specPath = specPath,+                  moduleRoot = if rootLabel == "(none)" then "" else rootLabel,+                  layout = layout,+                  sourceLanguage = sourceLanguage,+                  languageContract = languageContract,+                  namingEdition = namingEdition,+                  moduleRoles = moduleRoles,+                  files = files,+                  mappings = mappings,+                  idDomains = idDomains,+                  nominalEqualities = nominalEqualities,+                  bindingObligations = bindingEntries,+                  behaviorRequirements = behaviorEntries,+                  projectionCatalogFacts = catalogFacts,+                  queryContractBaseline = queryContractBaseline,+                  queryContracts = queryContracts,+                  routerSelections = routerSelections,+                  semanticImpact = semanticImpact                 }   _ -> Nothing   where@@ -222,13 +222,20 @@         payload <- T.stripPrefix "semantic-impact " row         Just <$> Aeson.decodeStrict' (Text.encodeUtf8 payload)       _ -> Nothing+    parseModuleRole :: Text -> Maybe ScaffoldModuleRoleRow     parseModuleRole row = do       payload <- T.stripPrefix "module-role " row       decoded <- Aeson.decodeStrict' (Text.encodeUtf8 payload)       checkedRole decoded+    checkedRole :: ScaffoldModuleRoleRow -> Maybe ScaffoldModuleRoleRow     checkedRole roleRow = do-      path <- checkedPath (T.pack (srrPath roleRow))-      pure roleRow {srrPath = path}+      path <- checkedPath (T.pack ((.path) roleRow))+      pure+        ScaffoldModuleRoleRow+          { role = (.role) roleRow,+            kind = (.kind) roleRow,+            path = path+          }     checkedPath pathText =       let path = T.unpack pathText        in if null path || isAbsolute path || ".." `elem` splitDirectories path@@ -252,21 +259,21 @@       [row] -> T.stripPrefix "naming-edition " row >>= parseGeneratedHaskellNamingEdition       _ -> Nothing     hasDuplicateMappingNames mappings =-      let names = map mappingSpecName mappings+      let names = map (.specName) mappings        in length names /= length (nub names)     hasDuplicates values = length values /= length (nub values)     hasDuplicateBindingObligations obligations =       let keys = map bindingKey obligations        in length keys /= length (nub keys)     bindingKey hole =-      ( holeMappedName hole,-        holeModule hole,-        holeSymbol hole,-        holeKind hole,-        holePath hole+      ( (.mappedName) hole,+        (.moduleName) hole,+        (.symbol) hole,+        (.kind) hole,+        (.path) hole       )     hasDuplicateBehaviorRequirements requirements =-      let keys = map behaviorRecordKey requirements+      let keys = map (.key) requirements        in length keys /= length (nub keys)  recordFileName :: Text -> FilePath@@ -286,109 +293,109 @@   projectionCatalogFactsWith (checkedSpec service) (checkedProjectionSupplies service)  projectionCatalogFactsWith :: Spec -> ProjectionSupplyAnalysis -> [Text]-projectionCatalogFactsWith spec supplyAnalysis = sort (concatMap nodeFacts (specNodes spec) <> map supplyFact supplies)+projectionCatalogFactsWith spec supplyAnalysis = sort (concatMap nodeFacts ((.nodes) spec) <> map supplyFact supplies)   where-    supplies = resolvedProjectionSupplies supplyAnalysis-    owners = [owner | NProjectionOwner owner <- specNodes spec]+    supplies = (.resolvedProjectionSupplies) supplyAnalysis+    owners = [owner | NProjectionOwner owner <- (.nodes) spec]     nodeFacts (NProjectionTarget target) =-      [T.intercalate "|" ["target", ptName target, ptSchema target, ptTable target, resetText (ptReset target), T.intercalate "," (ptDependsOn target), lineText (ptLoc target)]]+      [T.intercalate "|" ["target", (.name) target, (.schema) target, (.table) target, resetText ((.reset) target), T.intercalate "," ((.dependsOn) target), lineText ((.loc) target)]]     nodeFacts (NRebuildGroup groupNode) =-      [T.intercalate "|" ["group", rgName groupNode, T.intercalate "," (sort (rgTargets groupNode)), T.intercalate "," (rgOrder groupNode), lineText (rgLoc groupNode)]]+      [T.intercalate "|" ["group", (.name) groupNode, T.intercalate "," (sort ((.targets) groupNode)), T.intercalate "," ((.order) groupNode), lineText ((.loc) groupNode)]]     nodeFacts (NProjectionRevision revision) =       [ T.intercalate           "|"           [ "revision",-            prvName revision,-            prvGroup revision,-            T.intercalate ";" (map revisionTargetText (prvTargets revision)),-            lineText (prvLoc revision)+            (.name) revision,+            (.group) revision,+            T.intercalate ";" (map revisionTargetText ((.targets) revision)),+            lineText ((.loc) revision)           ]       ]     nodeFacts (NExternalRead externalRead) =       [ T.intercalate           "|"           [ "external-read",-            erName externalRead,-            T.pack (show (erVersion externalRead)),-            erQueryModel externalRead,-            erResultSchema externalRead <> "." <> erResultType externalRead,+            (.name) externalRead,+            T.pack (show ((.version) externalRead)),+            (.queryModel) externalRead,+            (.resultSchema) externalRead <> "." <> (.resultType) externalRead,             externalReadShape externalRead,-            T.intercalate "," (sort (erCompatibleRevisions externalRead)),-            T.pack (show (erSurfaceGeneration externalRead)),-            lineText (erLoc externalRead)+            T.intercalate "," (sort ((.compatibleRevisions) externalRead)),+            T.pack (show ((.surfaceGeneration) externalRead)),+            lineText ((.loc) externalRead)           ]       ]     nodeFacts (NProjectionOwner owner) =       [ T.intercalate           "|"           [ "owner",-            poName owner,-            T.intercalate "," (map sourceText (poSources owner)),-            poGroup owner,-            T.intercalate "," (sort (poTargets owner)),-            T.pack (show (poOrder owner)),-            maybe "" id (poSubscription owner),-            maybe "" id (poDedup owner),-            T.intercalate "," (map checkpointOnMissingText (poCheckpointOnMissing owner)),-            replayText (poReplay owner),-            lineText (poLoc owner)+            (.name) owner,+            T.intercalate "," (map sourceText ((.sources) owner)),+            (.group) owner,+            T.intercalate "," (sort ((.targets) owner)),+            T.pack (show ((.order) owner)),+            maybe "" id ((.subscription) owner),+            maybe "" id ((.dedup) owner),+            T.intercalate "," (map checkpointOnMissingText ((.checkpointOnMissing) owner)),+            replayText ((.replay) owner),+            lineText ((.loc) owner)           ],         T.intercalate           "|"           [ "delivery",-            poName owner,-            deliveryText (poDelivery owner),-            lineText (poLoc owner)+            (.name) owner,+            deliveryText ((.delivery) owner),+            lineText ((.loc) owner)           ]       ]     nodeFacts (NReadModel readModel)-      | Just groupName <- rmGroup readModel =+      | Just groupName <- (.group) readModel =           [ T.intercalate               "|"               [ "query",-                rmName readModel,+                (.name) readModel,                 groupName,-                T.intercalate "," (sort (rmObservedTargets readModel)),+                T.intercalate "," (sort ((.observedTargets) readModel)),                 fromMaybe "" (effectiveBacking readModel),-                lineText (rmLoc readModel)+                lineText ((.loc) readModel)               ],             T.intercalate               "|"               [ "freshness",-                rmName readModel,-                freshnessText (rmFreshness readModel),-                lineText (rmLoc readModel)+                (.name) readModel,+                freshnessText ((.freshness) readModel),+                lineText ((.loc) readModel)               ],             T.intercalate               "|"               [ "cursor",-                rmName readModel,+                (.name) readModel,                 fromMaybe "none" (resolvedCursor readModel),-                lineText (rmLoc readModel)+                lineText ((.loc) readModel)               ]           ]     nodeFacts _ = []-    externalReadShape externalRead = case [rmShape readModel | NReadModel readModel <- specNodes spec, rmName readModel == erQueryModel externalRead] of+    externalReadShape externalRead = case [(.shape) readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.queryModel) externalRead] of       shape : _ -> shape       [] -> "missing-query"     revisionTargetText target =       T.intercalate         ","-        [ prtTarget target,-          prtSchemaVersion target,-          prtProvisioner target,-          T.pack (show (prtProvisionerVersion target)),-          prtExpectedShape target,-          prtValidator target,-          T.pack (show (prtValidatorVersion target)),-          T.intercalate ":" (map promotionText (prtPromotionObjects target))+        [ (.target) target,+          (.schemaVersion) target,+          (.provisioner) target,+          T.pack (show ((.provisionerVersion) target)),+          (.expectedShape) target,+          (.validator) target,+          T.pack (show ((.validatorVersion) target)),+          T.intercalate ":" (map promotionText ((.promotionObjects) target))         ]     promotionText promotionObject =       T.intercalate         ">"-        [ promotionKindText (rpoKind promotionObject),-          rpoGenerationName promotionObject,-          rpoCanonicalName promotionObject+        [ promotionKindText ((.kind) promotionObject),+          (.generationName) promotionObject,+          (.canonicalName) promotionObject         ]     promotionKindText PromotionIndexNode = "index"     promotionKindText PromotionConstraintNode = "constraint"@@ -397,16 +404,16 @@       T.intercalate         "|"         [ "supply",-          supplyQueryModel supply,-          supplyProjectionOwner supply,-          supplyRebuildGroup supply,-          T.intercalate "," (NE.toList (supplyObservedTargets supply)),-          lineText (supplyQueryLoc supply),-          lineText (supplyOwnerLoc supply)+          (.queryModel) supply,+          (.projectionOwner) supply,+          (.rebuildGroup) supply,+          T.intercalate "," (NE.toList ((.observedTargets) supply)),+          lineText ((.queryLoc) supply),+          lineText ((.ownerLoc) supply)         ]-    effectiveBacking readModel = case rmBackingTarget readModel of+    effectiveBacking readModel = case (.backingTarget) readModel of       Just targetName -> Just targetName-      Nothing -> case sort (rmObservedTargets readModel) of+      Nothing -> case sort ((.observedTargets) readModel) of         [targetName] -> Just targetName         _ -> Nothing     resetText TargetClear = "clear"@@ -420,18 +427,18 @@     freshnessText (FreshnessWaitForHead RmEntireLog) = "wait-for-head:entire-log"     freshnessText (FreshnessWaitForHead (RmCategory categoryName)) = "wait-for-head:category:" <> categoryName     resolvedCursor readModel = do-      ownerName <- case [ supplyProjectionOwner supply+      ownerName <- case [ (.projectionOwner) supply                         | supply <- supplies,-                          supplyQueryModel supply == rmName readModel+                          (.queryModel) supply == (.name) readModel                         ] of         [name] -> Just name         _ -> Nothing-      owner <- case [candidate | candidate <- owners, poName candidate == ownerName] of+      owner <- case [candidate | candidate <- owners, (.name) candidate == ownerName] of         [candidate] -> Just candidate         _ -> Nothing-      case poDelivery owner of+      case (.delivery) owner of         DeliveryInline -> Nothing-        DeliverySubscription -> poSubscription owner+        DeliverySubscription -> (.subscription) owner     checkpointOnMissingText CheckpointFromBeginning = "from-beginning"     checkpointOnMissingText CheckpointFromCurrentHead = "from-current-head"     checkpointOnMissingText CheckpointFail = "fail"

src/Keiro/Dsl/ScaffoldRun.hs view

@@ -2,1719 +2,2053 @@ -- execution so every refusal is known before the first output byte is written. module Keiro.Dsl.ScaffoldRun   ( Refusal (..),-    WriteDisposition (..),-    GeneratedArtifactCategory (..),-    GeneratedArtifactImpact (..),-    StaleGeneratedEvidence (..),-    StaleModule (..),-    MappingDrift (..),-    QueryContractMigration (..),-    SourceLanguageDrift (..),-    ScaffoldReport (..),-    scaffoldServiceModules,-    scaffoldServiceModulesWithGoldens,-    scaffoldModules,-    scaffoldModulesWithGoldens,-    planIndexedServiceScaffold,-    planIndexedServiceScaffoldWithGoldens,-    planIndexedServiceScaffoldWithRuntimePackage,-    planIndexedServiceScaffoldWithRuntimePackageAndGoldens,-    executeServiceScaffold,-    executeServiceScaffoldWithRuntimePackage,-    executeServiceScaffoldWithRuntimePackageAndNameMigrations,-    executeScaffold,-    executeScaffoldWithLanguage,-    renderRefusals,-    renderScaffoldReport,-    checkedSemanticImpactSnapshot,-    semanticImpactForMappingDrift,-    generatedArtifactImpact,-    renderSemanticImpactReport,-    renderGeneratedArtifactImpact,-    renderRouterSelectionDrift,--    -- * Shared with whole-workspace scaffolding ("Keiro.Dsl.WorkspaceScaffold")--    ---    -- $shared-    planningGatePipeline,-    planningRefusalDiagnostics,-    checkIndexedServiceDiagnostics,-    inertNodesOf,-    renderInertNodeSection,-    withSidecarMovesApplied,-    originLine,-    pureRefusalsForService,-    auditGeneratedHaskell,-    missingGeneratedBanners,-    staleAgainst,-    PreparedSourceMove,-    preparedSourceMove,-    preflightSourceMoves,-    applyPreparedSourceMoves,-    constraintPlanForService,-    mappingDrift,-    behaviorDrift,-    newBindingObligations,-    queryContractMigrations,-    obligationKindLabel,-    renderMappingIdentity,-  )-where--import Data.List (sortOn)-import Data.List.NonEmpty qualified as NE-import Data.Map.Strict qualified as Map-import Data.Set qualified as Set-import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.IO qualified as TIO-import Keiro.Dsl.BehaviorCoverage (BehaviorDerivationError, BehaviorKey (..), BehaviorRecordRow (..), behaviorRecordRows, deriveBehaviorRequirementsForService)-import Keiro.Dsl.BehaviorCoverage qualified as Behavior-import Keiro.Dsl.BehaviorSourceMap (BehaviorSourceFailure)-import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource-import Keiro.Dsl.ConformancePackage-  ( ConformancePackageFailure,-    ConformancePackageReport,-    ConformanceServiceKey (StandaloneConformanceService),-    executePreparedConformancePackage,-    planConformancePackage,-    preflightConformancePackage,-    renderConformancePackageFailure,-    renderConformancePackageReport,-  )-import Keiro.Dsl.CoordinationImpact (RouterSelectionDrift, renderRouterSelectionDrift, routerSelectionDrift, routerSelectionSnapshots)-import Keiro.Dsl.ExplainBindings (BindingHole (..), BindingObligationKind (..), bindingHolesForService)-import Keiro.Dsl.FoldFingerprint (FoldSurfaceError, aggregateFoldSurfaceForService, renderFoldSurfaceError)-import Keiro.Dsl.Goldens (GoldenPayload)-import Keiro.Dsl.Grammar (EmitNode (..), Loc (..), Node (..), OperationNode (..), PgmqDispatchNode (..), Spec (..))-import Keiro.Dsl.Harness (harnessForServiceWithGoldens, harnessProcess, harnessReadModelForService, harnessRouterForService, harnessWorkflow)-import Keiro.Dsl.HaskellName (currentGeneratedHaskellNamingEdition)-import Keiro.Dsl.HaskellName qualified as HaskellName-import Keiro.Dsl.HaskellSourceMove-import Keiro.Dsl.IdDomain (idDomainIdentitiesForService)-import Keiro.Dsl.LanguageVersion (SourceLanguage (..), effectiveLanguageVersion, languageVersionText, sourceFormText)-import Keiro.Dsl.Manifest (moduleNameOf, renderManifestForServiceWithFacade)-import Keiro.Dsl.MappedConsumer (ConsumerPlan (..), MappingIdentity (..), consumerPlanForService)-import Keiro.Dsl.NominalType (nominalEqualityIdentitiesForService)-import Keiro.Dsl.ProjectionMappedImpact (ProjectionMappedImpact, projectionMappedImpactForService, renderProjectionMappedImpact)-import Keiro.Dsl.ReadModelQueryContract-import Keiro.Dsl.RuntimePackage (RuntimePackageName)-import Keiro.Dsl.Scaffold-import Keiro.Dsl.ScaffoldRecord (ScaffoldModuleRoleRow (..), ScaffoldRecord (..), parseRecord, projectionCatalogFactsForService, recordFileName, renderRecord)-import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedService, checkedSpec, checkedTypeGraph, effectiveLanguageContract, legacyCheckedService)-import Keiro.Dsl.SemanticImpact-  ( MappedImpactDelta (..),-    MappedRootEvidence (..),-    SemanticImpactReport (..),-    SemanticImpactSnapshot (..),-    diffSemanticImpact,-    mappedConsequenceIdentity,-    mappedConsumerIdentity,-    mappedRootKindIdentity,-    semanticImpactForService,-    semanticImpactReport,-    semanticImpactSnapshot,-  )-import Keiro.Dsl.ServiceHarness (DuplicateServiceFactKey (..), serviceConformanceModuleName, serviceHarnessModule)-import Keiro.Dsl.SidecarMigration-import Keiro.Dsl.SidecarNames (contextCabalFragmentFileName)-import Keiro.Dsl.Source (SourcePoint (..), SourceSpan (..))-import Keiro.Dsl.SourceIndex (SemanticSourceIndex)-import Keiro.Dsl.StructuralConformance (structuralConformanceModule)-import Keiro.Dsl.TypeGraph (MappedKey (..), TypeGraph (..), UseSite (..))-import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), validateService)-import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile, renameFile)-import System.FilePath (takeDirectory, (</>))-import Text.Read (readMaybe)---- $shared--- These are the pieces whole-workspace scaffolding reuses verbatim rather than--- reimplementing, so a workspace and a single spec can never disagree about what--- counts as a refusal, what counts as stale, or how an identity renders.--- "Keiro.Dsl.WorkspaceScaffold" cannot live in this module because--- "Keiro.Dsl.Workspace" already imports it (its cross-member collision check asks--- the planner), so the seam is exports rather than shared privates.--data Refusal-  = PathCollision !FilePath ![Text]-  | FirewallBreach ![(FilePath, Text, Int)]-  | LoweringRefusal ![Text]-  | MissingGeneratedBanner ![FilePath]-  | ImportCycle ![Text]-  | BehaviorRefusal ![BehaviorDerivationError]-  | BehaviorSourceRefusal ![BehaviorSourceFailure]-  | -- | Persisted fold identity could not be resolved canonically.-    FoldSurfaceRefusal !FoldSurfaceError-  | -- | Source provenance and semantic planning selected different contracts.-    --       This is an internal/API misuse refusal and is detected before writes.-    SemanticContractMismatch !Text-  | -- | Golden payload fixtures found beside a workspace member that the one-    --       workspace golden root does not have. Raised only by the workspace path.-    GoldenRootDivergence !FilePath ![FilePath]-  | DuplicateConformanceFactKeys ![DuplicateServiceFactKey]-  | ConformancePackageRefusal !ConformancePackageFailure-  | GeneratedNameInvariantViolation ![Text]-  | NameMigrationRequired ![SourceMove]-  | NameMigrationRefusal ![Text]-  | SidecarMigrationRequired ![SidecarMove]-  | SidecarMigrationRefusal ![Text]-  | -- | Not a refusal on its own: an accompanying note that the run had already-    --       applied its sidecar renames before a later gate refused. Every other-    --       refusal says "nothing was written", which without this note is false.-    --       The renames are idempotent and forward-consistent, so re-running after-    --       fixing the refusal is correct and needs no undo.-    SidecarMovesAlreadyApplied ![SidecarMove]-  deriving stock (Eq, Show)---- | What one module write did. 'Unchanged' means an existing Generated module--- already had identical bytes, or is reported by the workspace write path under--- the same rule.-data WriteDisposition = Overwritten | Created | Skipped | Unchanged-  deriving stock (Eq, Show)--data GeneratedArtifactCategory-  = AggregateGeneratedArtifact-  | ServiceStructuralConformanceArtifact-  | BehaviorSourceMapArtifact-  | OtherGeneratedArtifact-  deriving stock (Eq, Ord, Show)--data GeneratedArtifactImpact = GeneratedArtifactImpact-  { artifactCategory :: !GeneratedArtifactCategory,-    artifactRole :: !ModuleRole,-    artifactPath :: !FilePath,-    artifactDisposition :: !WriteDisposition-  }-  deriving stock (Eq, Show)--data StaleGeneratedEvidence-  = ExactGeneratedBannerPresent-  | ExactGeneratedBannerMissing-  deriving stock (Eq, Show)--data StaleModule = StaleModule-  { staleKind :: !ModuleKind,-    stalePath :: !FilePath,-    staleGeneratedEvidence :: !(Maybe StaleGeneratedEvidence)-  }-  deriving stock (Eq, Show)--data MappingDrift = MappingDrift-  { driftSpecName :: !Text,-    driftPrevious :: !(Maybe MappingIdentity),-    driftCurrent :: !(Maybe MappingIdentity)-  }-  deriving stock (Eq, Show)--data SourceLanguageDrift = SourceLanguageDrift-  { languageDriftPrevious :: !SourceLanguage,-    languageDriftCurrent :: !SourceLanguage-  }-  deriving stock (Eq, Show)--data ScaffoldReport = ScaffoldReport-  { reportSpecPath :: !FilePath,-    reportOutDir :: !FilePath,-    reportContext :: !Context,-    reportDispositions :: ![(ScaffoldModule, WriteDisposition)],-    reportInertNodes :: ![(Text, Text)],-    reportManifestPath :: !FilePath,-    reportRecordPath :: !FilePath,-    reportPreviousSpecPath :: !(Maybe Text),-    reportStale :: ![StaleModule],-    reportConsumerPlan :: !ConsumerPlan,-    reportConstraintPlan :: ![Text],-    reportMappingDrift :: ![MappingDrift],-    reportQueryContractBaselineUnavailable :: !Bool,-    reportQueryContractDrift :: ![QueryContractDrift],-    reportQueryContractMigrations :: ![QueryContractMigration],-    reportSemanticImpact :: !SemanticImpactReport,-    reportRouterSelectionDrift :: ![RouterSelectionDrift],-    reportProjectionMappedImpact :: !(Maybe ProjectionMappedImpact),-    reportGeneratedArtifactImpact :: ![GeneratedArtifactImpact],-    reportSourceLanguageDrift :: !(Maybe SourceLanguageDrift),-    reportNewHoles :: ![BindingHole],-    reportAddedBehavior :: ![BehaviorRecordRow],-    reportRemovedBehavior :: ![BehaviorRecordRow],-    reportObsoleteOutputHooks :: ![(Text, Text)],-    reportConformancePackage :: !(Maybe ConformancePackageReport),-    reportNameMoves :: ![SourceMove],-    reportSidecarMoves :: ![SidecarMove]-  }-  deriving stock (Eq, Show)--data QueryContractMigration = QueryContractMigration-  { qcmOwner :: !Text,-    qcmHolePath :: !FilePath,-    qcmRequiredImport :: !Text-  }-  deriving stock (Eq, Show)---- | Produce the complete in-memory module set under a checked semantic--- contract. Keeping this registry in one place prevents the CLI and tests from--- drifting apart.-scaffoldServiceModules :: Context -> CheckedService -> [ScaffoldModule]-scaffoldServiceModules = scaffoldServiceModulesWithGoldens []--scaffoldServiceModulesWithGoldens :: [GoldenPayload] -> Context -> CheckedService -> [ScaffoldModule]-scaffoldServiceModulesWithGoldens goldens = scaffoldServiceModulesWithBehaviorSource goldens []--scaffoldServiceModulesWithBehaviorSource :: [GoldenPayload] -> [BehaviorSource.BehaviorSourceEntry] -> Context -> CheckedService -> [ScaffoldModule]-scaffoldServiceModulesWithBehaviorSource goldens sourceEntries ctx service =-  structuralConformanceModules ctx service-    <> maybe [] pure (behaviorSourceMapModule ctx sourceEntries)-    <> scaffoldStructuralForService ctx service-    <> scaffoldReplayAudit ctx spec-    <> scaffoldProjectionCatalogForService ctx service-    <> concat-      [ case node of-          NAggregate agg -> scaffoldAggregateForService ctx service agg <> harnessForServiceWithGoldens goldens ctx service agg-          NProcess process -> scaffoldProcess ctx process <> harnessProcess ctx process-          NRouter router -> scaffoldRouterForService ctx service router <> harnessRouterForService ctx service router-          NContract contract -> scaffoldContractForService ctx service contract-          NIntake intake -> scaffoldIntake ctx intake-          NPublisher publisher -> scaffoldPublisher ctx publisher-          NWorkqueue workqueue -> scaffoldWorkqueueForService ctx service workqueue-          NReadModel readModel ->-            let resolved = resolveCatalogReadModel spec readModel-             in scaffoldReadModelForService ctx service resolved <> harnessReadModelForService ctx service resolved-          NProjectionTarget _ -> []-          NRebuildGroup _ -> []-          NProjectionRevision _ -> []-          NExternalRead _ -> []-          NProjectionOwner _ -> []-          NWorkflow workflow -> harnessWorkflow ctx workflow-          NEmit _ -> []-          NPgmqDispatch _ -> []-          NOperation _ -> []-      | node <- specNodes spec-      ]-  where-    spec = checkedSpec service--structuralConformanceModules :: Context -> CheckedService -> [ScaffoldModule]-structuralConformanceModules ctx service = case structuralConformanceModule ctx service of-  Left failures -> error ("checked structural conformance planning failed: " <> show failures)-  Right Nothing -> []-  Right (Just moduleValue) -> [moduleValue]---- | Compatibility wrapper that explicitly selects legacy/version-1 semantics.-scaffoldModules :: Context -> Spec -> [ScaffoldModule]-scaffoldModules = scaffoldModulesWithGoldens []--scaffoldModulesWithGoldens :: [GoldenPayload] -> Context -> Spec -> [ScaffoldModule]-scaffoldModulesWithGoldens goldens ctx = scaffoldServiceModulesWithGoldens goldens ctx . legacyCheckedService---- | Run every pure refusal gate under the effective semantic contract. A--- successful result is the exact write set; a refusal has no write set and--- therefore cannot be accidentally executed.-planIndexedServiceScaffold :: SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planIndexedServiceScaffold = planIndexedServiceScaffoldWithRuntimePackage Nothing--planIndexedServiceScaffoldWithGoldens :: [GoldenPayload] -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planIndexedServiceScaffoldWithGoldens goldens = planIndexedServiceScaffoldWithRuntimePackageAndGoldens goldens Nothing---- | Add the one service-level conformance facade only when the runtime package--- is explicitly configured. The package name itself is build metadata; facade--- naming depends solely on the service context and placement policy.-planIndexedServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planIndexedServiceScaffoldWithRuntimePackage = planIndexedServiceScaffoldWithRuntimePackageAndGoldens []--planIndexedServiceScaffoldWithRuntimePackageAndGoldens :: [GoldenPayload] -> Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]-planIndexedServiceScaffoldWithRuntimePackageAndGoldens goldens runtimePackage sourceIndex ctx service = do-  -- Preserve the established refusal precedence. Structural/path/import and-  -- behavior-derivation defects are decidable without exact provenance and-  -- must not be hidden by a later source-anchor join failure.-  _ <- planningGatePipeline ctx service baseModulePlan (Right ())-  planningGatePipeline ctx service completeModulePlan (Right ())-  where-    facadeModules = case runtimePackage of-      Nothing -> Right []-      Just _ -> fmap pure (serviceHarnessModule ctx service)-    baseModulePlan = case facadeModules of-      Left duplicates -> Left [DuplicateConformanceFactKeys duplicates]-      Right facades ->-        Right $-          stampGeneratedModules-            (checkedLanguageContract service)-            (scaffoldServiceModulesWithGoldens goldens ctx service <> facades)-    completeModulePlan =-      case (behaviorSourcePlan, facadeModules) of-        (Left refusals, _) -> Left refusals-        (_, Left duplicates) -> Left [DuplicateConformanceFactKeys duplicates]-        (Right sourceEntries, Right facades) ->-          Right $-            stampGeneratedModules-              (checkedLanguageContract service)-              (scaffoldServiceModulesWithBehaviorSource goldens sourceEntries ctx service <> facades)-    behaviorSourcePlan = do-      requirements <- either (Left . pure . BehaviorRefusal) Right (deriveBehaviorRequirementsForService service)-      either (Left . pure . BehaviorSourceRefusal) Right (BehaviorSource.planBehaviorSourceMap requirements sourceIndex)---- | The one pure scaffold-planning gate sequence. Both scaffold planners and--- both check paths consume this function, so the first reported refusal cannot--- drift by input shape.-planningGatePipeline ::-  Context ->-  CheckedService ->-  Either [Refusal] [ScaffoldModule] ->-  Either [Refusal] () ->-  Either [Refusal] [ScaffoldModule]-planningGatePipeline ctx service modulePlan packagePlan =-  case traverse (aggregateFoldSurfaceForService service) [aggregate | NAggregate aggregate <- specNodes spec] of-    Left surfaceError -> Left [FoldSurfaceRefusal surfaceError]-    Right _ -> case scaffoldRefusalsForService service of-      lowering@(_ : _) -> Left [LoweringRefusal lowering]-      [] -> case modulePlan of-        Left refusals -> Left refusals-        Right modules -> case packagePlan of-          Left refusals -> Left refusals-          Right () -> case pureRefusalsForService ctx service modules of-            [] -> Right modules-            refusals -> Left refusals-  where-    spec = checkedSpec service---- | The nodes a spec declares that contribute no generated module.------ They are still parsed, validated, and diff-classified; naming them in the--- scaffold report is what stops an author from concluding the toolchain lost--- their declaration. Shared by the single-spec and workspace planners so a--- workspace — the recommended layout — reports exactly what one spec reports.-inertNodesOf :: Spec -> [(Text, Text)]-inertNodesOf spec =-  [ (kindLabel, nodeName)-  | node <- specNodes spec,-    (kindLabel, nodeName) <- case node of-      NEmit emitNode -> [("emit", emName emitNode)]-      NPgmqDispatch dispatchNode -> [("dispatch", pdName dispatchNode)]-      NOperation operationNode -> [("operation", opName operationNode)]-      _ -> []-  ]---- | The report line naming 'inertNodesOf', or nothing when every declaration--- produced a module.-renderInertNodeSection :: [(Text, Text)] -> [Text]-renderInertNodeSection = \case-  [] -> []-  nodes ->-    [ "no-modules: "-        <> T.intercalate ", " [kindLabel <> " " <> nodeName | (kindLabel, nodeName) <- nodes]-        <> " (validated and diff-classified; no generated modules)"-    ]---- | Validate a checked service, then run the shared planning gates unless an--- error makes module generation unsound. 'GeneratedOccurrenceCollision' is the--- deliberate exception: the workspace path already plans through it so the--- stronger whole-path collision can cite every claimant. Existing diagnostics--- retain their order and planning diagnostics follow them.-checkIndexedServiceDiagnostics :: Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> [Diagnostic]-checkIndexedServiceDiagnostics runtimePackage sourceIndex ctx service-  | any blocksPlanning validationDiagnostics = validationDiagnostics-  | otherwise =-      validationDiagnostics-        <> case planIndexedServiceScaffoldWithRuntimePackage runtimePackage sourceIndex ctx service of-          Right _ -> []-          Left refusals -> planningRefusalDiagnostics refusals-  where-    validationDiagnostics = validateService service-    blocksPlanning diagnostic =-      severity diagnostic == Error-        && code diagnostic /= GeneratedOccurrenceCollision---- | Present pure planning refusals through check's stable located diagnostic--- vocabulary. Planner-invariant failures retain the detailed scaffold refusal--- text in their message while receiving one machine code.-planningRefusalDiagnostics :: [Refusal] -> [Diagnostic]-planningRefusalDiagnostics = concatMap diagnosticsFor-  where-    diagnosticsFor (PathCollision path origins) = [pathCollisionDiagnostic path origins]-    diagnosticsFor (ImportCycle path) =-      [ planningError 1 GeneratedImportCycle $-          "generated/consumer import cycle "-            <> T.intercalate " -> " path-            <> "; keep bindings in a leaf module that imports only Structural.Shape.* and Keiro.Codec.Structural"-      ]-    diagnosticsFor (BehaviorRefusal errors) =-      [ planningError (behaviorErrorLine behaviorError) BehaviorDerivationInvalid $-          "behavior obligations cannot be derived soundly: " <> T.pack (show behaviorError)-      | behaviorError <- errors-      ]-    diagnosticsFor (BehaviorSourceRefusal failures) =-      [ planningError (behaviorSourceFailureLine failure) (behaviorSourceDiagnosticCode failure) $-          "behavior source map cannot be planned for "-            <> Behavior.unBehaviorKey (BehaviorSource.failureKey failure)-            <> " ("-            <> BehaviorSource.failureAggregate failure-            <> ":"-            <> BehaviorSource.failureState failure-            <> " -- "-            <> BehaviorSource.failureCommand failure-            <> ", subject="-            <> T.pack (show (BehaviorSource.failureSourceSubject failure))-            <> "): "-            <> BehaviorSource.failureMessage failure-      | failure <- failures-      ]-    diagnosticsFor (DuplicateConformanceFactKeys duplicates) =-      [ planningError 1 ConformanceFactKeyCollision $-          "normalized service conformance fact key '"-            <> duplicateServiceFactKey duplicate-            <> "' is produced more than once"-      | duplicate <- duplicates-      ]-    diagnosticsFor refusal =-      [ planningError 1 GeneratedPlanningInvariantViolation $-          "validated service failed an internal scaffold-planning invariant: "-            <> T.intercalate " | " (renderRefusals [refusal])-      ]--    pathCollisionDiagnostic path origins =-      Diagnostic-        { line = primaryLine,-          severity = Error,-          code = GeneratedPathCollision,-          relatedLocations =-            [ (claimLine, "claimed here by " <> claimOrigin)-            | (claimLine, claimOrigin) <- remainingClaims-            ],-          message =-            "generated module path '"-              <> T.pack path-              <> "' is claimed more than once; on a case-insensitive filesystem these are one file; claimants: "-              <> T.intercalate "; " origins-        }-      where-        orderedClaims = reverse (sortOn fst [(claimLine, claimOrigin) | claimOrigin <- origins, Just claimLine <- [originLine claimOrigin]])-        (primaryLine, remainingClaims) = case orderedClaims of-          (claimLine, _) : rest -> (claimLine, rest)-          [] -> (1, [])--    behaviorErrorLine (Behavior.DuplicateBehaviorIdentity _ locations) = maximum (1 : map unLoc locations)-    behaviorErrorLine _ = 1--    behaviorSourceFailureLine failure = case BehaviorSource.failureSpan failure of-      Just SourceSpan {start = SourcePoint {line = sourceLine}} -> sourceLine-      Nothing -> 1-    behaviorSourceDiagnosticCode failure = case BehaviorSource.failureCode failure of-      BehaviorSource.BehaviorSourceAnchorMissing -> BehaviorSourceAnchorMissing-      BehaviorSource.BehaviorSourceAnchorInexact -> BehaviorSourceAnchorInexact-      BehaviorSource.BehaviorSourceAnchorCollision -> BehaviorSourceAnchorCollision--    planningError diagnosticLine diagnosticCode diagnosticMessage =-      Diagnostic-        { line = diagnosticLine,-          severity = Error,-          code = diagnosticCode,-          relatedLocations = [],-          message = diagnosticMessage-        }---- | Recover the source line embedded in a generated module's origin text,--- which scaffold formats as @<kind> <name> (line N)@.-originLine :: Text -> Maybe Int-originLine originText = do-  withoutClose <- T.stripSuffix ")" originText-  let (before, after) = T.breakOnEnd " (line " withoutClose-  if T.null before then Nothing else readMaybe (T.unpack after)---- | Every pure refusal gate, over an already-built module set: case-folded path--- collisions, generated\/consumer collisions and import cycles, firewall breaches,--- and lowering refusals. Whole-workspace planning builds its module set from the--- merged spec and then runs exactly this, so no gate can apply to one input shape--- and not the other.-pureRefusalsForService :: Context -> CheckedService -> [ScaffoldModule] -> [Refusal]-pureRefusalsForService ctx service modules =-  collisionRefusals modules-    <> dependencyRefusalsForService ctx service modules-    <> [FirewallBreach breaches | not (null breaches)]-    <> [GeneratedNameInvariantViolation namingViolations | not (null namingViolations)]-    <> [LoweringRefusal lowering | let lowering = scaffoldRefusalsForService service, not (null lowering)]-    <> [BehaviorRefusal errors | Left errors <- [deriveBehaviorRequirementsForService service]]-  where-    breaches = firewallBreaches modules-    namingViolations = generatedNameInvariantViolations modules--generatedNameInvariantViolations :: [ScaffoldModule] -> [Text]-generatedNameInvariantViolations = concatMap auditGeneratedHaskell---- | Inventory and check declarations in one generated source file.  The--- lexical mask keeps comments and literals out of the declaration inventory;--- this is deliberately a final defense after the typed naming plan, so a--- literal template declaration cannot bypass the checked constructors.-auditGeneratedHaskell :: ScaffoldModule -> [Text]-auditGeneratedHaskell scaffoldModule = lexicalErrors <> declarationErrors <> duplicateDeclarationErrors <> occurrenceErrors-  where-    expectedModule = moduleNameOf (modulePath scaffoldModule)-    (lexicalErrors, codeSource) = case maskNonCode (moduleText scaffoldModule) of-      Left message -> ([prefix 1 <> message], "")-      Right masked -> ([], masked)-    sourceLines = zip [1 :: Int ..] (T.lines codeSource)-    declarationErrors = moduleDeclarationErrors <> moduleSegmentErrors-    moduleDeclarationErrors = case declaredModuleName codeSource of-      Nothing -> [T.pack (modulePath scaffoldModule) <> ": missing Haskell module declaration"]-      Just declared-        | declared == expectedModule -> []-        | otherwise ->-            [ T.pack (modulePath scaffoldModule)-                <> ": declares "-                <> declared-                <> " but its planned module is "-                <> expectedModule-            ]-    moduleSegmentErrors =-      [ prefix 1 <> "module segment '" <> segment <> "' is not UpperCamelCase"-      | segment <- T.splitOn "." expectedModule,-        isLeftName (HaskellName.checkedModuleSegment (auditSite HaskellName.NodeModuleSite segment 1) segment)-      ]-    occurrenceErrors =-      concat-        [ checkCandidates lineNumber (signatureCandidates sourceLine)-            <> checkCandidates lineNumber (typeCandidates sourceLine)-            <> checkCandidates lineNumber (constructorCandidates sourceLine)-            <> checkCandidates lineNumber (topLevelValueCandidates sourceLine)-        | (lineNumber, sourceLine) <- sourceLines-        ]--    duplicateDeclarationErrors = duplicateErrors "top-level type signature" signatureCandidates <> duplicateErrors "top-level type declaration" typeCandidates-    duplicateErrors label candidates =-      [ prefix laterLine-          <> "repeated "-          <> label-          <> " '"-          <> candidate-          <> "' (first declared at line "-          <> tshow firstLine-          <> ")"-      | (candidate, declarationLines) <- Map.toAscList declarations,-        firstLine : laterLines <- [declarationLines],-        laterLine <- laterLines-      ]-      where-        declarations =-          Map.fromListWith-            (flip (++))-            [ (candidate, [lineNumber])-            | (lineNumber, sourceLine) <- sourceLines,-              sourceLine == T.stripStart sourceLine,-              candidate <- candidates sourceLine-            ]--    checkCandidates lineNumber = concatMap (checkCandidate lineNumber)-    checkCandidate lineNumber candidate-      | T.null candidate = []-      | asciiUpperInitial candidate =-          [prefix lineNumber <> "generated declaration '" <> candidate <> "' is not UpperCamelCase" | isLeftName (HaskellName.checkedUpperOccurrence (auditSite HaskellName.GeneratedTypeSite candidate lineNumber) candidate)]-      | otherwise =-          [prefix lineNumber <> "generated declaration '" <> candidate <> "' is not lowerCamelCase" | isLeftName (HaskellName.checkedLowerOccurrence (auditSite HaskellName.GeneratedValueSite candidate lineNumber) candidate)]--    prefix lineNumber = T.pack (modulePath scaffoldModule) <> ":" <> tshow lineNumber <> ": "--    auditSite kind candidate lineNumber =-      HaskellName.NameSite-        { HaskellName.siteKind = kind,-          HaskellName.siteLogicalName = candidate,-          HaskellName.siteOwner = T.pack (modulePath scaffoldModule),-          HaskellName.siteLine = lineNumber-        }--isLeftName :: Either left right -> Bool-isLeftName = \case Left _ -> True; Right _ -> False--declaredModuleName :: Text -> Maybe Text-declaredModuleName source =-  case [T.takeWhile moduleCharacter (T.drop 7 sourceLine) | sourceLine <- T.lines source, "module " `T.isPrefixOf` sourceLine] of-    declaration : _ | not (T.null declaration) -> Just declaration-    _ -> Nothing-  where-    moduleCharacter character = identifierCharacter character || character == '.'--signatureCandidates :: Text -> [Text]-signatureCandidates sourceLine-  | T.null suffix || T.any (`elem` ['=', '(', ')', '[', ']']) prefix = []-  | otherwise = filter isIdentifier (map T.strip (T.splitOn "," prefix))-  where-    (prefix, suffix) = T.breakOn "::" (T.strip sourceLine)--typeCandidates :: Text -> [Text]-typeCandidates sourceLine = case T.words (T.strip sourceLine) of-  keyword : candidate : _-    | keyword `elem` ["data", "newtype", "type"], candidate /= "family", candidate /= "instance" -> [cleanIdentifier candidate]-  _ -> []--constructorCandidates :: Text -> [Text]-constructorCandidates sourceLine-  | "|" `T.isPrefixOf` stripped = takeFollowingIdentifier (T.drop 1 stripped)-  | any (`T.isPrefixOf` stripped) ["data ", "newtype "] = takeFollowingIdentifier (T.drop 1 (snd (T.breakOn "=" stripped)))-  | otherwise = []-  where-    stripped = T.strip sourceLine-    takeFollowingIdentifier value = case T.words value of-      candidate : _ | asciiUpperInitial (cleanIdentifier candidate) -> [cleanIdentifier candidate]-      _ -> []--topLevelValueCandidates :: Text -> [Text]-topLevelValueCandidates sourceLine-  | T.null sourceLine || T.head sourceLine == ' ' || T.head sourceLine == '\t' = []-  | T.null suffix = []-  | otherwise = case T.words prefix of-      candidate : _-        | candidate `notElem` declarationKeywords,-          isIdentifier candidate ->-            [candidate]-      _ -> []-  where-    (prefix, suffix) = T.breakOn "=" sourceLine-    declarationKeywords = ["data", "newtype", "type", "class", "instance", "module", "import", "deriving", "infix", "infixl", "infixr"]--cleanIdentifier :: Text -> Text-cleanIdentifier = T.takeWhile identifierCharacter . T.dropWhile (not . identifierCharacter)--isIdentifier :: Text -> Bool-isIdentifier candidate = not (T.null candidate) && T.all identifierCharacter candidate--identifierCharacter :: Char -> Bool-identifierCharacter character =-  (character >= 'A' && character <= 'Z')-    || (character >= 'a' && character <= 'z')-    || (character >= '0' && character <= '9')-    || character == '_'-    || character == '\''--asciiUpperInitial :: Text -> Bool-asciiUpperInitial candidate = case T.uncons candidate of-  Just (first, _) -> first >= 'A' && first <= 'Z'-  Nothing -> False--data AuditLexState = AuditCode | AuditLineComment | AuditBlockComment !Int | AuditString | AuditCharacter--maskNonCode :: Text -> Either Text Text-maskNonCode = fmap T.pack . go AuditCode . T.unpack-  where-    go state input = case (state, input) of-      (AuditCode, []) -> Right []-      (AuditLineComment, []) -> Right []-      (AuditBlockComment _, []) -> Left "unterminated block comment in generated source"-      (AuditString, []) -> Left "unterminated string literal in generated source"-      (AuditCharacter, []) -> Left "unterminated character literal in generated source"-      (AuditCode, '-' : '-' : rest) -> prependSpaces 2 <$> go AuditLineComment rest-      (AuditCode, '{' : '-' : rest) -> prependSpaces 2 <$> go (AuditBlockComment 1) rest-      (AuditCode, '"' : rest) -> (' ' :) <$> go AuditString rest-      (AuditCode, '\'' : rest)-        | looksLikeCharacterLiteral rest -> (' ' :) <$> go AuditCharacter rest-      (AuditCode, character : rest) -> (character :) <$> go AuditCode rest-      (AuditLineComment, '\n' : rest) -> ('\n' :) <$> go AuditCode rest-      (AuditLineComment, _ : rest) -> (' ' :) <$> go AuditLineComment rest-      (AuditBlockComment depth, '{' : '-' : rest) -> prependSpaces 2 <$> go (AuditBlockComment (depth + 1)) rest-      (AuditBlockComment 1, '-' : '}' : rest) -> prependSpaces 2 <$> go AuditCode rest-      (AuditBlockComment depth, '-' : '}' : rest) -> prependSpaces 2 <$> go (AuditBlockComment (depth - 1)) rest-      (AuditBlockComment depth, '\n' : rest) -> ('\n' :) <$> go (AuditBlockComment depth) rest-      (AuditBlockComment depth, _ : rest) -> (' ' :) <$> go (AuditBlockComment depth) rest-      (AuditString, '\\' : _escaped : rest) -> prependSpaces 2 <$> go AuditString rest-      (AuditString, '"' : rest) -> (' ' :) <$> go AuditCode rest-      (AuditString, '\n' : _) -> Left "newline in generated string literal"-      (AuditString, _ : rest) -> (' ' :) <$> go AuditString rest-      (AuditCharacter, '\\' : _escaped : rest) -> prependSpaces 2 <$> go AuditCharacter rest-      (AuditCharacter, '\'' : rest) -> (' ' :) <$> go AuditCode rest-      (AuditCharacter, '\n' : _) -> Left "newline in generated character literal"-      (AuditCharacter, _ : rest) -> (' ' :) <$> go AuditCharacter rest--    prependSpaces count suffix = replicate count ' ' <> suffix-    looksLikeCharacterLiteral = \case-      '\\' : _escaped : '\'' : _ -> True-      _character : '\'' : _ -> True-      _ -> False--dependencyRefusalsForService :: Context -> CheckedService -> [ScaffoldModule] -> [Refusal]-dependencyRefusalsForService ctx service modules = collisionWithConsumers <> namespaceCycles-  where-    plan = consumerPlanForService service-    generatedByName = Map.fromList [(moduleNameOf (modulePath moduleValue), moduleValue) | moduleValue <- modules, kind moduleValue == Generated]-    collisionWithConsumers =-      [ PathCollision-          (modulePath generated)-          [origin generated, "consumer module " <> consumerModule]-      | consumerModule <- consumerModules plan,-        Just generated <- [Map.lookup consumerModule generatedByName]-      ]-    namespaceCycles =-      [ ImportCycle [importer, consumerModule, importer]-      | consumerModule <- consumerModules plan,-        generatedNamespaceOwned ctx consumerModule,-        importer <- take 1 (importersOf consumerModule modules <> [contextGeneratedRoot ctx])-      ]--generatedNamespaceOwned :: Context -> Text -> Bool-generatedNamespaceOwned ctx consumerModule = case placement ctx of-  GeneratedPrefix -> contextGeneratedRoot ctx `T.isPrefixOf` consumerModule-  CollocatedLeaf ->-    (root <> contextSegment <> ".") `T.isPrefixOf` consumerModule-      && ".Generated" `T.isInfixOf` consumerModule-  where-    root = if T.null (moduleRoot ctx) then "" else moduleRoot ctx <> "."-    contextSegment = pascalFromKebab (contextName ctx)--contextGeneratedRoot :: Context -> Text-contextGeneratedRoot ctx = case placement ctx of-  GeneratedPrefix -> root <> "Generated." <> contextSegment-  CollocatedLeaf -> root <> contextSegment <> ".Generated"-  where-    root = if T.null (moduleRoot ctx) then "" else moduleRoot ctx <> "."-    contextSegment = pascalFromKebab (contextName ctx)--importersOf :: Text -> [ScaffoldModule] -> [Text]-importersOf imported =-  map (moduleNameOf . modulePath)-    . filter (any (importsModule imported) . T.lines . moduleText)--importsModule :: Text -> Text -> Bool-importsModule expected line = case T.words (T.strip line) of-  "import" : rest -> expected `elem` rest-  _ -> False--collisionRefusals :: [ScaffoldModule] -> [Refusal]-collisionRefusals modules =-  [ PathCollision (modulePath first) (map origin (first : rest))-  | first : rest <- Map.elems grouped,-    not (null rest)-  ]-  where-    grouped =-      Map.fromListWith-        (flip (<>))-        [(T.toCaseFold (T.pack (modulePath m)), [m]) | m <- modules]---- | Check existing generated paths, then perform the deterministic writes and--- manifest rewrite. Banner refusal is evaluated for the complete set before the--- output directory is created or any file is changed.-executeScaffold :: FilePath -> Bool -> FilePath -> Context -> Spec -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)-executeScaffold out forceGeneratedOverwrite specPath ctx spec modules =-  executeScaffoldWithLanguage out forceGeneratedOverwrite specPath LegacyUnversioned ctx spec modules---- | Source-aware execution used by the CLI; semantic planning still receives only 'Spec'.-executeScaffoldWithLanguage :: FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> Spec -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)-executeScaffoldWithLanguage out forceGeneratedOverwrite specPath sourceLanguage ctx spec modules =-  executeServiceScaffold out forceGeneratedOverwrite specPath sourceLanguage ctx (checkedService sourceLanguage spec) modules---- | Execute a module plan while retaining both the effective semantic contract--- and the source declaration provenance written to history. A mismatch refuses--- before checking or creating any output path.-executeServiceScaffold :: FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)-executeServiceScaffold = executeServiceScaffoldWithRuntimePackage Nothing--executeServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)-executeServiceScaffoldWithRuntimePackage runtimePackage =-  executeServiceScaffoldWithRuntimePackageAndNameMigrations runtimePackage False--executeServiceScaffoldWithRuntimePackageAndNameMigrations :: Maybe RuntimePackageName -> Bool -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)-executeServiceScaffoldWithRuntimePackageAndNameMigrations runtimePackage applyNameMigrations out forceGeneratedOverwrite specPath sourceLanguage ctx service plannedModules-  | effectiveLanguageContract sourceLanguage /= checkedLanguageContract service =-      pure (Left [SemanticContractMismatch "source provenance and checked service selected different effective language contracts"])-  | otherwise = case packagePlan of-      Left failures -> pure (Left (map ConformancePackageRefusal failures))-      Right plannedPackage -> do-        sidecarResult <- planSidecarMigrations out (ContextSidecars (specContext spec)) plannedPackage-        case sidecarResult of-          Left reasons -> pure (Left [SidecarMigrationRefusal reasons])-          Right preparedSidecars-            | not (null preparedSidecars) && not applyNameMigrations ->-                pure (Left [SidecarMigrationRequired (map preparedSidecarMove preparedSidecars)])-            | otherwise -> do-                applyPreparedSidecarMoves out preparedSidecars-                let moves = map preparedSidecarMove preparedSidecars-                    -- Past this point the renames are on disk, so a later-                    -- refusal's "nothing was written" needs qualifying.-                    noteApplied = withSidecarMovesApplied moves-                result <- case plannedPackage of-                  Nothing -> executeCheckedScaffold moves Nothing-                  Just package -> do-                    preparedPackage <- preflightConformancePackage out forceGeneratedOverwrite package-                    case preparedPackage of-                      Left failures -> pure (Left (map ConformancePackageRefusal failures))-                      Right packageReady -> executeCheckedScaffold moves (Just packageReady)-                pure (either (Left . noteApplied) Right result)-  where-    spec = checkedSpec service-    modules = stampGeneratedModules (checkedLanguageContract service) plannedModules-    facadeModule = case runtimePackage of-      Nothing -> Nothing-      Just _ -> Just (serviceConformanceModuleName ctx)-    packagePlan =-      traverse-        (\packageName -> planConformancePackage (StandaloneConformanceService (contextName ctx)) packageName (serviceConformanceModuleName ctx) service)-        runtimePackage-    executeCheckedScaffold sidecarMoves preparedPackage =-      case deriveBehaviorRequirementsForService service of-        Left errors -> pure (Left [BehaviorRefusal errors])-        Right requirements -> do-          bannerless <- if forceGeneratedOverwrite then pure [] else missingGeneratedBanners out modules-          if not (null bannerless)-            then pure (Left [MissingGeneratedBanner bannerless])-            else do-              let recordPath = out </> recordFileName (specContext spec)-              previousRecord <- readRecord recordPath-              case planRecordedSourceMoves previousRecord modules of-                Left moveErrors -> pure (Left [NameMigrationRefusal [T.pack (show moveError) | moveError <- NE.toList moveErrors]])-                Right moves -> do-                  preparedMoves <- preflightSourceMoves out moves-                  case preparedMoves of-                    Left moveErrors -> pure (Left [NameMigrationRefusal moveErrors])-                    Right prepared-                      | not (null prepared) && not applyNameMigrations ->-                          pure (Left [NameMigrationRequired (map preparedSourceMove prepared)])-                      | otherwise -> do-                          applyPreparedSourceMoves out prepared-                          stale <- maybe (pure []) (existingStale out modules) previousRecord-                          queryMigrations <- queryContractMigrations out modules-                          let currentConsumerPlan = consumerPlanForService service-                              drift = maybe [] (mappingDrift (consumerMappings currentConsumerPlan) . recMappings) previousRecord-                              currentQueryContracts = either (const []) id (queryContractIdentitiesForService service)-                              queryHistoryBaseline =-                                not (null currentQueryContracts)-                                  || maybe False recQueryContractBaseline previousRecord-                              queryBaselineUnavailable =-                                not (null currentQueryContracts)-                                  && maybe False (not . recQueryContractBaseline) previousRecord-                              queryDrift = case previousRecord of-                                Just previous | recQueryContractBaseline previous -> queryContractDrift currentQueryContracts (recQueryContracts previous)-                                _ -> []-                              currentSemanticImpact = checkedSemanticImpactSnapshot service-                              semanticReport = semanticImpactForMappingDrift (previousRecord >>= recSemanticImpact) currentSemanticImpact drift-                              currentRouterSelections = routerSelectionSnapshots service-                              selectionDrift = maybe [] (\previous -> routerSelectionDrift (recRouterSelections previous) currentRouterSelections) previousRecord-                              languageDrift = do-                                previous <- previousRecord-                                if recSourceLanguage previous == sourceLanguage-                                  then Nothing-                                  else Just (SourceLanguageDrift (recSourceLanguage previous) sourceLanguage)-                              currentObligations = either (const []) id (bindingHolesForService service)-                              newHoles = maybe [] (newBindingObligations currentObligations . recBindingObligations) previousRecord-                              currentBehavior = behaviorRecordRows requirements-                              (addedBehavior, removedBehavior) = maybe (currentBehavior, []) (behaviorDrift currentBehavior . recBehaviorRequirements) previousRecord-                          createDirectoryIfMissing True out-                          dispositions <- mapM (writeModule out) modules-                          let manifestPath = out </> contextCabalFragmentFileName (specContext spec)-                          TIO.writeFile manifestPath (renderManifestForServiceWithFacade facadeModule (T.pack specPath) modules service)-                          TIO.writeFile recordPath (renderRecord (currentRecord specPath sourceLanguage ctx service modules queryHistoryBaseline currentBehavior currentSemanticImpact))-                          packageReport <- traverse executePreparedConformancePackage preparedPackage-                          pure $-                            Right-                              ScaffoldReport-                                { reportSpecPath = specPath,-                                  reportOutDir = out,-                                  reportContext = ctx,-                                  reportDispositions = dispositions,-                                  reportInertNodes = inertNodesOf spec,-                                  reportManifestPath = manifestPath,-                                  reportRecordPath = recordPath,-                                  reportPreviousSpecPath = recSpecPath <$> previousRecord,-                                  reportStale = stale,-                                  reportConsumerPlan = currentConsumerPlan,-                                  reportConstraintPlan = constraintPlanForService service currentConsumerPlan,-                                  reportMappingDrift = drift,-                                  reportQueryContractBaselineUnavailable = queryBaselineUnavailable,-                                  reportQueryContractDrift = queryDrift,-                                  reportQueryContractMigrations = queryMigrations,-                                  reportSemanticImpact = semanticReport,-                                  reportRouterSelectionDrift = selectionDrift,-                                  reportProjectionMappedImpact = projectionMappedImpactForService service,-                                  reportGeneratedArtifactImpact = generatedArtifactImpact dispositions,-                                  reportSourceLanguageDrift = languageDrift,-                                  reportNewHoles = newHoles,-                                  reportAddedBehavior = addedBehavior,-                                  reportRemovedBehavior = removedBehavior,-                                  reportObsoleteOutputHooks = obsoleteGeneratedOutputHooksForService service,-                                  reportConformancePackage = packageReport,-                                  reportNameMoves = map preparedSourceMove prepared,-                                  reportSidecarMoves = sidecarMoves-                                }--planRecordedSourceMoves :: Maybe ScaffoldRecord -> [ScaffoldModule] -> Either (NE.NonEmpty SourceMoveError) [SourceMove]-planRecordedSourceMoves Nothing _ = Right []-planRecordedSourceMoves (Just previous) current =-  planSourceMoves priorArtifacts current-  where-    priorArtifacts = case recModuleRoles previous of-      [] -> [(Nothing, fileKind, path) | (fileKind, path) <- recFiles previous]-      rows -> [(Just (srrRole row), srrKind row, srrPath row) | row <- rows]--data PreparedSourceMove-  = SourceMoveReady !SourceMove !Text-  | SourceMoveAlreadyApplied !SourceMove--preparedSourceMove :: PreparedSourceMove -> SourceMove-preparedSourceMove = \case-  SourceMoveReady move _ -> move-  SourceMoveAlreadyApplied move -> move--preflightSourceMoves :: FilePath -> [SourceMove] -> IO (Either [Text] [PreparedSourceMove])-preflightSourceMoves out moves = do-  prepared <- mapM preflight moves-  let errors = [message | Left message <- prepared]-  pure $ if null errors then Right [value | Right value <- prepared] else Left errors-  where-    replacements = Map.fromList [(moveOldModule move, moveNewModule move) | move <- moves]-    preflight move = do-      let oldPath = out </> moveOldPath move-          newPath = out </> moveNewPath move-          backupPath = out </> moveBackupPath move-          preparedPath = preparedSourcePath out move-          statePath = sourceMoveStatePath out move-      oldExists <- doesFileExist oldPath-      newExists <- doesFileExist newPath-      backupExists <- doesFileExist backupPath-      preparedExists <- doesFileExist preparedPath-      stateExists <- doesFileExist statePath-      case (oldExists, backupExists) of-        (True, True) -> conflict move newExists backupExists preparedExists "both legacy source and backup exist"-        (False, False) ->-          if newExists-            then conflict move newExists backupExists preparedExists "target exists without a recoverable legacy source"-            else pure (Left (T.pack (moveOldPath move) <> ": recorded legacy source is missing"))-        _ -> do-          source <- TIO.readFile (if oldExists then oldPath else backupPath)-          if moveKind move == Generated && not (any isGeneratedBannerLine (T.lines source))-            then pure (Left (T.pack (moveOldPath move) <> ": generated source lacks an exact generated banner"))-            else case rewriteHaskellModuleReferences replacements source of-              Left lexicalError -> pure (Left (T.pack (moveOldPath move) <> ": " <> T.pack (show lexicalError)))-              Right rewritten-                | not (declaresExpectedModule (moveNewModule move) rewritten) ->-                    pure-                      ( Left-                          ( T.pack (moveOldPath move)-                              <> ": transformed source does not declare expected module "-                              <> moveNewModule move-                          )-                      )-                | otherwise -> do-                    let hydrated =-                          move-                            { moveContentDigest = Just (contentDigest source),-                              moveTransformedDigest = Just (contentDigest rewritten)-                            }-                        expectedState = renderSourceMoveState hydrated-                    stateError <- verifyOptionalText stateExists statePath expectedState "migration state"-                    preparedError <- verifyOptionalDigest preparedExists preparedPath (contentDigest rewritten) "prepared source"-                    targetError <- verifyOptionalDigest newExists newPath (contentDigest rewritten) "target source"-                    case [message | Just message <- [stateError, preparedError, targetError]] of-                      message : _ -> pure (Left (T.pack (moveOldPath move) <> ": " <> message))-                      []-                        | newExists && not backupExists && not oldExists -> conflict hydrated newExists backupExists preparedExists "target has no recoverable backup"-                        | newExists && backupExists && not oldExists -> pure (Right (SourceMoveAlreadyApplied hydrated))-                        | otherwise -> pure (Right (SourceMoveReady hydrated rewritten))--    conflict move newExists backupExists preparedExists reason =-      pure-        ( Left-            ( T.pack (moveOldPath move)-                <> ": migration state conflicts ("-                <> reason-                <> "; target="-                <> T.pack (show newExists)-                <> ", backup="-                <> T.pack (show backupExists)-                <> ", prepared="-                <> T.pack (show preparedExists)-                <> ")"-            )-        )--    verifyOptionalText False _ _ _ = pure Nothing-    verifyOptionalText True path expected label = do-      actual <- TIO.readFile path-      pure $ if actual == expected then Nothing else Just (label <> " digest/path evidence does not match")--    verifyOptionalDigest False _ _ _ = pure Nothing-    verifyOptionalDigest True path expected label = do-      actual <- contentDigest <$> TIO.readFile path-      pure $ if actual == expected then Nothing else Just (label <> " digest does not match " <> expected)--    declaresExpectedModule expected source =-      any (T.isPrefixOf ("module " <> expected <> " ")) (T.lines source)-        || any (== ("module " <> expected)) (T.lines source)--applyPreparedSourceMoves :: FilePath -> [PreparedSourceMove] -> IO ()-applyPreparedSourceMoves out prepared = do-  -- Prepare every transformed file and durable digest record before moving a-  -- single active source.  The temporary file lives beside its destination,-  -- so installation is a same-filesystem rename.-  mapM_ prepareMove prepared-  mapM_ backupMove prepared-  mapM_ installMove prepared-  where-    prepareMove preparedMove = do-      let move = preparedSourceMove preparedMove-          statePath = sourceMoveStatePath out move-      createDirectoryIfMissing True (takeDirectory statePath)-      TIO.writeFile statePath (renderSourceMoveState move)-      case preparedMove of-        SourceMoveAlreadyApplied _ -> pure ()-        SourceMoveReady _ rewritten -> do-          let path = preparedSourcePath out move-          createDirectoryIfMissing True (takeDirectory path)-          exists <- doesFileExist path-          if exists then pure () else TIO.writeFile path rewritten--    backupMove (SourceMoveAlreadyApplied _) = pure ()-    backupMove (SourceMoveReady move _) = do-      let oldPath = out </> moveOldPath move-          backupPath = out </> moveBackupPath move-      oldExists <- doesFileExist oldPath-      if oldExists-        then do-          createDirectoryIfMissing True (takeDirectory backupPath)-          renameFile oldPath backupPath-        else pure ()--    installMove preparedMove = do-      let move = preparedSourceMove preparedMove-          preparedPath = preparedSourcePath out move-          newPath = out </> moveNewPath move-      newExists <- doesFileExist newPath-      preparedExists <- doesFileExist preparedPath-      if newExists-        then if preparedExists then removeFile preparedPath else pure ()-        else do-          createDirectoryIfMissing True (takeDirectory newPath)-          renameFile preparedPath newPath--preparedSourcePath :: FilePath -> SourceMove -> FilePath-preparedSourcePath out move = out </> (moveNewPath move <> ".keiro-dsl-name-migration-prepared")--sourceMoveStatePath :: FilePath -> SourceMove -> FilePath-sourceMoveStatePath out move = out </> (moveBackupPath move <> ".keiro-dsl-name-migration-state")--renderSourceMoveState :: SourceMove -> Text-renderSourceMoveState move =-  T.unlines-    [ "keiro-dsl-name-migration-state v1",-      "old-path " <> T.pack (moveOldPath move),-      "new-path " <> T.pack (moveNewPath move),-      "old-module " <> moveOldModule move,-      "new-module " <> moveNewModule move,-      "source-digest " <> maybe "<missing>" id (moveContentDigest move),-      "transformed-digest " <> maybe "<missing>" id (moveTransformedDigest move)-    ]--constraintPlanForService :: CheckedService -> ConsumerPlan -> [Text]-constraintPlanForService service plan = case checkedTypeGraph service of-  Left _ -> []-  Right graph ->-    let registerRoots =-          Set.fromList-            [ key-            | RootRegister _ _ key <- tgUseSites graph-            ]-     in map (constraintFor registerRoots) (consumerMappings plan)-  where-    constraintFor registerRoots mapping =-      mappingSpecName mapping-        <> ": "-        <> T.intercalate ", " (baseConstraints mapping <> registerConstraints registerRoots mapping)-    baseConstraints StructuralMapping {} = ["Eq", "Show", "CanonicalTypeName", "StructuralBinding"]-    baseConstraints OpaqueMapping {} = ["Eq", "Show", "ToJSON", "FromJSON"]-    baseConstraints NominalMapping {} = ["Eq", "Show", "NominalBinding"]-    registerConstraints roots mapping-      | MappedKey (mappingSpecName mapping) `Set.member` roots = ["register initial", "snapshot ToJSON", "snapshot FromJSON"]-      | otherwise = []--mappingDrift :: [MappingIdentity] -> [MappingIdentity] -> [MappingDrift]-mappingDrift current previous =-  [ MappingDrift name old new-  | name <- Set.toAscList (Map.keysSet oldByName <> Map.keysSet newByName),-    let old = Map.lookup name oldByName,-    let new = Map.lookup name newByName,-    old /= new-  ]-  where-    oldByName = Map.fromList [(mappingSpecName mapping, mapping) | mapping <- previous]-    newByName = Map.fromList [(mappingSpecName mapping, mapping) | mapping <- current]--checkedSemanticImpactSnapshot :: CheckedService -> SemanticImpactSnapshot-checkedSemanticImpactSnapshot service = case checkedTypeGraph service of-  Left failures -> error ("validated scaffold type graph did not resolve: " <> show failures)-  Right graph -> semanticImpactSnapshot (semanticImpactForService service graph)--semanticImpactForMappingDrift :: Maybe SemanticImpactSnapshot -> SemanticImpactSnapshot -> [MappingDrift] -> SemanticImpactReport-semanticImpactForMappingDrift previous current drifts =-  semanticImpactReport previous current changedDeclarations-  where-    driftDeclarations = [MappedKey (driftSpecName drift) | drift <- drifts]-    snapshotDeclarations = maybe [] (map impactDeclaration . (`diffSemanticImpact` current)) previous-    changedDeclarations = driftDeclarations <> snapshotDeclarations--generatedArtifactImpact :: [(ScaffoldModule, WriteDisposition)] -> [GeneratedArtifactImpact]-generatedArtifactImpact dispositions =-  sortOn-    artifactPath-    [ GeneratedArtifactImpact-        { artifactCategory = categoryFor role,-          artifactRole = role,-          artifactPath = modulePath scaffoldModule,-          artifactDisposition = disposition-        }-    | (scaffoldModule, disposition) <- dispositions,-      kind scaffoldModule == Generated,-      disposition `elem` [Overwritten, Created],-      let role = moduleRole scaffoldModule-    ]-  where-    categoryFor role-      | roleFamily role == "StructuralConformance" = ServiceStructuralConformanceArtifact-      | roleFamily role == "BehaviorSourceMap" = BehaviorSourceMapArtifact-      | roleOwnerKind role == "aggregate"-          || ": aggregate " `T.isInfixOf` roleOwnerName role =-          AggregateGeneratedArtifact-      | otherwise = OtherGeneratedArtifact--newBindingObligations :: [BindingHole] -> [BindingHole] -> [BindingHole]-newBindingObligations current previous =-  [ obligation-  | obligation <- current,-    obligation `Set.notMember` previousSet-  ]-  where-    previousSet = Set.fromList previous---- | Inspect, but never rewrite, an existing create-once read-model hole. A--- typed plan is complete only after the application removes its legacy local--- aliases and imports the generated QueryContract aliases.-queryContractMigrations :: FilePath -> [ScaffoldModule] -> IO [QueryContractMigration]-queryContractMigrations out modules = fmap concat (mapM inspect typedHoles)-  where-    typedHoles =-      [ (hole, requiredImport)-      | hole <- modules,-        kind hole == HoleStub,-        roleFamily (moduleRole hole) == "ReadModelHoles",-        requiredImport <- T.lines (moduleText hole),-        "import " `T.isPrefixOf` requiredImport,-        ".QueryContract (" `T.isInfixOf` requiredImport-      ]-    inspect (hole, requiredImport) = do-      let path = out </> modulePath hole-      exists <- doesFileExist path-      if not exists-        then pure []-        else do-          contents <- TIO.readFile path-          let ready = requiredImport `elem` T.lines contents && not (any isLocalQueryAlias (T.lines contents))-          pure-            [ QueryContractMigration-                { qcmOwner = queryOwner (moduleRole hole),-                  qcmHolePath = modulePath hole,-                  qcmRequiredImport = requiredImport-                }-            | not ready-            ]-    isLocalQueryAlias line = case T.words (T.strip line) of-      "type" : alias : "=" : _ -> "QueryInput" `T.isSuffixOf` alias || "QueryResult" `T.isSuffixOf` alias-      _ -> False-    queryOwner role = case T.words (roleOwnerName role) of-      "readmodel" : owner : _ -> owner-      _ -> roleOwnerName role--behaviorDrift :: [BehaviorRecordRow] -> [BehaviorRecordRow] -> ([BehaviorRecordRow], [BehaviorRecordRow])-behaviorDrift current previous =-  ( [row | row <- sortOn behaviorRecordKey current, behaviorRecordKey row `Set.notMember` previousKeys],-    [row | row <- sortOn behaviorRecordKey previous, behaviorRecordKey row `Set.notMember` currentKeys]-  )-  where-    currentKeys = Set.fromList (map behaviorRecordKey current)-    previousKeys = Set.fromList (map behaviorRecordKey previous)--readRecord :: FilePath -> IO (Maybe ScaffoldRecord)-readRecord path = do-  exists <- doesFileExist path-  if exists then parseRecord <$> TIO.readFile path else pure Nothing--existingStale :: FilePath -> [ScaffoldModule] -> ScaffoldRecord -> IO [StaleModule]-existingStale out modules record = staleAgainst out (map modulePath modules) (recFiles record)---- | The files a previous run recorded that the current plan no longer produces--- and that are still on disk. keiro-dsl never deletes; this is what the report--- lists for a human to review.-staleAgainst :: FilePath -> [FilePath] -> [(ModuleKind, FilePath)] -> IO [StaleModule]-staleAgainst out currentPathList previous = fmap concat $ mapM stillExists removed-  where-    currentPaths = Set.fromList currentPathList-    removed = [(fileKind, path) | (fileKind, path) <- previous, path `Set.notMember` currentPaths]-    stillExists (fileKind, path) = do-      let fullPath = out </> path-      exists <- doesFileExist fullPath-      if not exists-        then pure []-        else do-          evidence <- case fileKind of-            HoleStub -> pure Nothing-            Generated -> do-              contents <- TIO.readFile fullPath-              pure . Just $-                if any isGeneratedBannerLine (T.lines contents)-                  then ExactGeneratedBannerPresent-                  else ExactGeneratedBannerMissing-          pure [StaleModule fileKind path evidence]--currentRecord :: FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> Bool -> [BehaviorRecordRow] -> SemanticImpactSnapshot -> ScaffoldRecord-currentRecord specPath sourceLanguage ctx service modules queryHistoryBaseline currentBehavior currentSemanticImpact =-  ScaffoldRecord-    { recSpecPath = T.pack specPath,-      recModuleRoot = moduleRoot ctx,-      recLayout = case placement ctx of GeneratedPrefix -> "prefixed"; CollocatedLeaf -> "collocated",-      recSourceLanguage = sourceLanguage,-      recLanguageContract = checkedLanguageContract service,-      recNamingEdition = currentGeneratedHaskellNamingEdition,-      recModuleRoles = [ScaffoldModuleRoleRow (moduleRole m) (kind m) (modulePath m) | m <- modules],-      recFiles = [(kind m, modulePath m) | m <- modules],-      recMappings = consumerMappings (consumerPlanForService service),-      recIdDomains = idDomainIdentitiesForService service,-      recNominalEqualities = nominalEqualityIdentitiesForService service,-      recBindingObligations = either (const []) id (bindingHolesForService service),-      recBehaviorRequirements = currentBehavior,-      recProjectionCatalogFacts = projectionCatalogFactsForService service,-      recQueryContractBaseline = queryHistoryBaseline,-      recQueryContracts = either (const []) id (queryContractIdentitiesForService service),-      recRouterSelections = routerSelectionSnapshots service,-      recSemanticImpact = Just currentSemanticImpact-    }--missingGeneratedBanners :: FilePath -> [ScaffoldModule] -> IO [FilePath]-missingGeneratedBanners out modules = fmap concat $ mapM check generated-  where-    generated = [m | m <- modules, kind m == Generated]-    check m = do-      let path = out </> modulePath m-      exists <- doesFileExist path-      if not exists-        then pure []-        else do-          contents <- TIO.readFile path-          pure [modulePath m | not (any isGeneratedBannerLine (T.lines contents))]--writeModule :: FilePath -> ScaffoldModule -> IO (ScaffoldModule, WriteDisposition)-writeModule out m = do-  let path = out </> modulePath m-  createDirectoryIfMissing True (takeDirectory path)-  case kind m of-    Generated -> do-      exists <- doesFileExist path-      if exists-        then do-          existing <- TIO.readFile path-          if existing == moduleText m-            then pure (m, Unchanged)-            else TIO.writeFile path (moduleText m) >> pure (m, Overwritten)-        else TIO.writeFile path (moduleText m) >> pure (m, Overwritten)-    HoleStub -> do-      exists <- doesFileExist path-      if exists-        then pure (m, Skipped)-        else TIO.writeFile path (moduleText m) >> pure (m, Created)---- | Qualify a refusal set raised after the run's sidecar renames were applied.------ Every refusal message says "nothing was written", which is true of the module--- tree but not of the renames, so the note is appended rather than the claim--- being weakened everywhere. A refusal set that is empty stays empty.-withSidecarMovesApplied :: [SidecarMove] -> [Refusal] -> [Refusal]-withSidecarMovesApplied [] refusals = refusals-withSidecarMovesApplied _ [] = []-withSidecarMovesApplied moves refusals = refusals <> [SidecarMovesAlreadyApplied moves]--renderRefusals :: [Refusal] -> [Text]-renderRefusals = concatMap render-  where-    render (PathCollision path origins) =-      [ "error: module path collision -- refusing to scaffold; nothing was written",-        "  " <> T.pack path-      ]-        <> ["    from " <> source | source <- origins]-    render (FirewallBreach breaches) =-      [ "error: firewall breach -- refusing to scaffold; nothing was written",-        "firewall: BREACH (" <> tshow (length breaches) <> " forbidden token occurrence(s)):"-      ]-        <> ["  " <> T.pack path <> ":" <> tshow line <> " contains " <> token | (path, token, line) <- breaches]-    render (LoweringRefusal refusals) =-      ["error: scaffold cannot lower this spec faithfully -- refusing; nothing was written"]-        <> map ("  " <>) refusals-    render (MissingGeneratedBanner paths) =-      [ "error: refusing to overwrite " <> tshow (length paths) <> " file(s) at Generated paths that lack the '-- @generated' banner"-      ]-        <> map ("  " <>) (map T.pack paths)-        <> ["  (adopted as hand code? move it, or re-run with --force-generated-overwrite)", "nothing was written"]-    render (ImportCycle path) =-      [ "error: generated/consumer import cycle -- refusing to scaffold; nothing was written",-        "  " <> T.intercalate " -> " path,-        "  keep bindings in a leaf module that imports only Structural.Shape.* and Keiro.Codec.Structural"-      ]-    render (BehaviorRefusal errors) =-      ["error: behavior obligations cannot be derived soundly -- refusing to scaffold; nothing was written"]-        <> ["  " <> T.pack (show behaviorError) | behaviorError <- errors]-    render (BehaviorSourceRefusal failures) =-      ["error: behavior source map cannot be planned -- refusing to scaffold; nothing was written"]-        <> [ "  "-               <> T.pack (show (BehaviorSource.failureCode failure))-               <> " "-               <> Behavior.unBehaviorKey (BehaviorSource.failureKey failure)-               <> ": "-               <> BehaviorSource.failureMessage failure-           | failure <- failures-           ]-    render (GeneratedNameInvariantViolation violations) =-      ["error: generated Haskell name invariant violated -- refusing to scaffold; nothing was written"]-        <> map ("  " <>) violations-    render (NameMigrationRequired moves) =-      [ "error: name migration required: legacy-v1 -> idiomatic-v1; nothing was written",-        "re-run scaffold with --apply-name-migrations after reviewing these source moves:"-      ]-        <> map renderMove moves-    render (NameMigrationRefusal reasons) =-      ["error: name migration could not be applied safely; nothing was written"]-        <> map ("  " <>) reasons-    render (SidecarMigrationRequired moves) =-      [ "error: sidecar migration required; nothing was written",-        "re-run scaffold with --apply-name-migrations after reviewing these sidecar renames:"-      ]-        <> map (("  " <>) . renderSidecarMove) moves-    render (SidecarMigrationRefusal reasons) =-      ["error: sidecar migration could not be applied safely; nothing was written"]-        <> map ("  " <>) reasons-    render (SidecarMovesAlreadyApplied moves) =-      [ "note: this run had already applied "-          <> tshow (length moves)-          <> " sidecar rename(s) before the refusal above, so \"nothing was written\" excludes them:"-      ]-        <> map (("  " <>) . renderSidecarMove) moves-        <> [ "The renames are idempotent and carry no spec content, so re-running scaffold",-             "after fixing the refusal is correct; nothing needs to be undone."-           ]-    render (FoldSurfaceRefusal surfaceError) =-      [ "error: aggregate fold identity could not be resolved -- refusing to scaffold; nothing was written",-        "  " <> renderFoldSurfaceError surfaceError-      ]-    render (SemanticContractMismatch detail) =-      [ "error: semantic language contract mismatch -- refusing to scaffold; nothing was written",-        "  " <> detail-      ]-    render (GoldenRootDivergence root paths) =-      [ "error: golden payload fixtures live beside a workspace member instead of under the workspace golden root -- refusing to scaffold"-      ]-        <> ["  " <> T.pack path | path <- paths]-        <> [ "  move these files under " <> T.pack root <> "; keiro-dsl reads one golden root per workspace",-             "  (a fixture the root lacks would be silently replaced by a synthesized stand-in)",-             "nothing was written"-           ]-    render (DuplicateConformanceFactKeys duplicates) =-      ["error: duplicate normalized service conformance fact keys -- refusing to scaffold; nothing was written"]-        <> ["  " <> duplicateServiceFactKey duplicate | duplicate <- duplicates]-    render (ConformancePackageRefusal failure) = renderConformancePackageFailure failure-    renderMove move =-      "  "-        <> (case moveKind move of Generated -> "generated "; HoleStub -> "hole      ")-        <> moveOldModule move-        <> " -> "-        <> moveNewModule move-        <> "  backup: "-        <> T.pack (moveBackupPath move)--renderSemanticImpactReport :: SemanticImpactReport -> [Text]-renderSemanticImpactReport report = case semanticReportDeclarations report of-  [] -> []-  declarations ->-    ["semantic impact:"]-      <> case semanticReportPrevious report of-        Nothing ->-          ["  baseline: unavailable (legacy ledger)"]-            <> concatMap renderCurrent declarations-        Just _ -> concatMap renderDelta (semanticReportDeltas report)-  where-    renderCurrent declaration =-      [ "  " <> unMappedKey declaration,-        "    current aggregate consumers: " <> renderConsumers (Map.findWithDefault Set.empty declaration (snapshotMappedConsumers (semanticReportCurrent report))),-        "    current roots: " <> maybe "baseline unavailable" (renderEvidence . Map.findWithDefault Set.empty declaration) (snapshotMappedEvidence (semanticReportCurrent report)),-        "    current consequences: " <> maybe "baseline unavailable" (renderConsequences . Map.findWithDefault Set.empty declaration) (snapshotMappedConsequences (semanticReportCurrent report)),-        "    service-conformance: impacted"-      ]-    renderDelta delta =-      [ "  " <> unMappedKey (impactDeclaration delta),-        "    previous aggregate consumers: " <> renderConsumers (impactPreviousConsumers delta),-        "    current aggregate consumers:  " <> renderConsumers (impactCurrentConsumers delta),-        "    previous roots: " <> maybe "baseline unavailable" renderEvidence (impactPreviousEvidence delta),-        "    current roots:  " <> maybe "baseline unavailable" renderEvidence (impactCurrentEvidence delta),-        "    previous consequences: " <> maybe "baseline unavailable" renderConsequences (impactPreviousConsequences delta),-        "    current consequences:  " <> maybe "baseline unavailable" renderConsequences (impactCurrentConsequences delta),-        "    service-conformance: " <> if impactServiceConformance delta then "impacted" else "unchanged"-      ]-    renderConsumers aggregateConsumers = case map consumerName (Set.toAscList aggregateConsumers) of-      [] -> "(none)"-      names -> T.intercalate ", " names-    consumerName = mappedConsumerIdentity-    renderEvidence = renderSet renderRoot-    renderRoot evidence =-      T.intercalate "|" [mappedRootKindIdentity (evidenceRootKind evidence), mappedConsumerIdentity (evidenceConsumer evidence), evidencePath evidence]-        <> maybe "" ("|" <>) (evidenceOperation evidence)-    renderConsequences = renderSet mappedConsequenceIdentity-    renderSet render values = case map render (Set.toAscList values) of-      [] -> "(none)"-      rendered -> T.intercalate ", " rendered--renderGeneratedArtifactImpact :: SemanticImpactReport -> [GeneratedArtifactImpact] -> [Text]-renderGeneratedArtifactImpact _ [] = []-renderGeneratedArtifactImpact semanticReport impacts =-  "generated-artifact impact:" : map renderArtifact impacts-  where-    renderArtifact impact =-      "  "-        <> categoryLabel (artifactCategory impact)-        <> " "-        <> T.pack (artifactPath impact)-        <> " ("-        <> dispositionLabel (artifactDisposition impact)-        <> ")"-    categoryLabel AggregateGeneratedArtifact-      | null (semanticReportDeltas semanticReport) = "aggregate (generator or non-mapped drift; no mapped semantic impact)"-      | otherwise = "aggregate"-    categoryLabel ServiceStructuralConformanceArtifact = "service-conformance"-    categoryLabel BehaviorSourceMapArtifact = "behavior-source-map"-    categoryLabel OtherGeneratedArtifact = "generated"-    dispositionLabel Overwritten = "overwritten"-    dispositionLabel Created = "created"-    dispositionLabel Skipped = "skipped"-    dispositionLabel Unchanged = "unchanged"--renderScaffoldReport :: ScaffoldReport -> [Text]-renderScaffoldReport report =-  [ "scaffold: " <> T.pack (reportSpecPath report) <> " -> " <> T.pack (reportOutDir report) <> " (module-root=" <> rootLabel <> ", layout=" <> layoutLabel <> ")"-  ]-    <> map moduleLine dispositions-    <> inertNodeSection-    <> [ "firewall: OK (" <> tshow generatedCount <> " generated modules scanned, 0 forbidden operators)",-         harnessLine,-         dependencyLine,-         "fragment: " <> T.pack (reportManifestPath report),-         "ledger:   " <> T.pack (reportRecordPath report)-       ]-    <> previousSpecNote-    <> constraintSection-    <> newHolesSection-    <> queryContractSection-    <> queryContractMigrationSection-    <> mappingDriftSection-    <> renderSemanticImpactReport (reportSemanticImpact report)-    <> renderRouterSelectionDrift (reportRouterSelectionDrift report)-    <> maybe [] renderProjectionMappedImpact (reportProjectionMappedImpact report)-    <> renderGeneratedArtifactImpact (reportSemanticImpact report) (reportGeneratedArtifactImpact report)-    <> sourceLanguageDriftSection-    <> behaviorDriftSection-    <> obsoleteOutputSection-    <> sidecarMoveSection-    <> nameMoveSection-    <> staleSection-    <> maybe [] renderConformancePackageReport (reportConformancePackage report)-  where-    ctx = reportContext report-    dispositions = reportDispositions report-    rootLabel = if T.null (moduleRoot ctx) then "(none)" else moduleRoot ctx-    layoutLabel = case placement ctx of GeneratedPrefix -> "prefixed"; CollocatedLeaf -> "collocated"-    names = [moduleNameOf (modulePath m) | (m, _) <- dispositions]-    nameWidth = maximum (1 : map T.length names)-    moduleLine (m, disposition) =-      "  " <> kindTag (kind m) <> "  " <> pad (moduleNameOf (modulePath m)) <> "  " <> dispositionTag disposition-    kindTag Generated = "generated"-    kindTag HoleStub = "hole     "-    dispositionTag Overwritten = "(overwritten)"-    dispositionTag Created = "(created)"-    dispositionTag Skipped = "(skipped: already present)"-    dispositionTag Unchanged = "(unchanged)"-    pad name = name <> T.replicate (nameWidth - T.length name) " "-    generatedCount = length [() | (m, _) <- dispositions, kind m == Generated]-    inertNodeSection = renderInertNodeSection (reportInertNodes report)-    harnesses =-      sortOn-        id-        [ moduleNameOf (modulePath m)-        | (m, _) <- dispositions,-          any (`T.isSuffixOf` moduleNameOf (modulePath m)) [".Harness", ".ProcessHarness", ".WorkflowFacts"]-        ]-    harnessLine = case harnesses of-      [] -> "harness:  (none emitted)"-      _ -> "harness:  run `cabal test <your-component>` over " <> T.unwords harnesses-    dependencyLine =-      "dependency plan: consumer packages "-        <> renderBracketed (consumerPackages (reportConsumerPlan report))-        <> ", consumer modules "-        <> renderBracketed (consumerModules (reportConsumerPlan report))-    constraintSection = case reportConstraintPlan report of-      [] -> []-      constraints -> "constraint plan:" : map ("  " <>) constraints-    newHolesSection = case reportNewHoles report of-      [] -> []-      obligations ->-        ["newly required holes since last scaffold: " <> tshow (length obligations)]-          <> concatMap obligationLines obligations-    obligationLines hole =-      [ "  " <> holeModule hole,-        "    " <> holeSignature hole <> " (" <> obligationKindLabel (holeKind hole) <> ")"-      ]-    queryContractSection =-      [ "query contract history: baseline unavailable in the previous ledger; no legacy `()` API was inferred"-      | reportQueryContractBaselineUnavailable report-      ]-        <> case reportQueryContractDrift report of-          [] -> []-          drifts ->-            ["query contract drift: " <> tshow (length drifts) <> " input/result position(s) changed since the previous scaffold:"]-              <> concatMap queryDriftLines drifts-    queryDriftLines drift =-      [ "  " <> readModel <> " " <> queryPositionLabel position,-        "    previous: " <> maybe "(absent)" renderQueryIdentity (qcdPrevious drift),-        "    current:  " <> maybe "(absent)" renderQueryIdentity (qcdCurrent drift)-      ]-      where-        (readModel, position) = qcdKey drift-    renderQueryIdentity identity =-      qciTypeExpression identity-        <> " mapped=["-        <> T.intercalate ", " (qciMappedDependencies identity)-        <> "]"-    queryPositionLabel QueryInputConsumer = "input"-    queryPositionLabel QueryResultConsumer = "result"-    queryContractMigrationSection = case reportQueryContractMigrations report of-      [] -> []-      migrations ->-        ["query contract migration required: " <> tshow (length migrations) <> " hand-owned hole module(s)"]-          <> concatMap migrationLines migrations-    migrationLines migration =-      [ "  " <> qcmOwner migration,-        "    edit " <> T.pack (qcmHolePath migration),-        "    remove the local QueryInput/QueryResult type aliases",-        "    add " <> qcmRequiredImport migration-      ]-    previousSpecNote = case reportPreviousSpecPath report of-      Just previous-        | previous /= T.pack (reportSpecPath report) ->-            [ "note: the previous scaffold record used spec " <> previous,-              "      specs sharing context " <> contextName ctx <> " in one --out also share " <> T.pack (reportManifestPath report)-            ]-      _ -> []-    mappingDriftSection = case reportMappingDrift report of-      [] -> []-      drifts ->-        ["mapping drift: " <> tshow (length drifts) <> " declaration(s) changed since the previous scaffold:"]-          <> concatMap driftLines drifts-    driftLines drift =-      [ "  " <> driftSpecName drift,-        "    previous: " <> maybe "(absent)" renderMappingIdentity (driftPrevious drift),-        "    current:  " <> maybe "(absent)" renderMappingIdentity (driftCurrent drift)-      ]-    sourceLanguageDriftSection = case reportSourceLanguageDrift report of-      Nothing -> []-      Just drift ->-        [ "source-language drift: "-            <> sourceLanguageLabel (languageDriftPrevious drift)-            <> " -> "-            <> sourceLanguageLabel (languageDriftCurrent drift)-            <> " (generated module bytes are semantic and unaffected)"-        ]-    behaviorDriftSection =-      renderBehaviorRows "new behavior obligations" (reportAddedBehavior report)-        <> renderBehaviorRows "removed behavior obligations (consumer rows become stale)" (reportRemovedBehavior report)-    renderBehaviorRows _ [] = []-    renderBehaviorRows label rows =-      [label <> ": " <> tshow (length rows)] <> concatMap behaviorLines rows-    behaviorLines row =-      [ "  "-          <> behaviorRecordAggregate row-          <> ":"-          <> behaviorRecordSource row-          <> " -- "-          <> behaviorRecordCommand row-          <> "  "-          <> unBehaviorKey (behaviorRecordKey row),-        "    Pending (BehaviorKey " <> tshow (unBehaviorKey (behaviorRecordKey row)) <> ")"-      ]-    obsoleteOutputSection = case reportObsoleteOutputHooks report of-      [] -> []-      hooks ->-        ["obsolete identity-copy output hooks (if still present, they are unused and may be removed):"]-          <> ["  " <> aggregate <> ".Holes." <> hook | (aggregate, hook) <- hooks]-    sidecarMoveSection = case reportSidecarMoves report of-      [] -> []-      moves ->-        ["sidecar migration: applied (" <> tshow (length moves) <> " move(s))"]-          <> map (("  " <>) . renderSidecarMove) moves-    nameMoveSection = case reportNameMoves report of-      [] -> []-      moves ->-        ["name migration: applied (" <> tshow (length moves) <> " source move(s))"]-          <> ["  backup: " <> T.pack (moveBackupPath move) | move <- moves]-    staleSection = case reportStale report of-      [] -> []-      stale ->-        [ "stale: " <> tshow (length stale) <> " file(s) from a previous scaffold of context " <> contextName ctx <> " are no longer produced by this spec:"-        ]-          <> map staleLine stale-          <> ["note: keiro-dsl never deletes files."]-    staleLine stale = case (staleKind stale, staleGeneratedEvidence stale) of-      (Generated, Just ExactGeneratedBannerPresent) ->-        "  generated " <> T.pack (stalePath stale) <> "  (exact generated banner present; verify unchanged bytes before deleting)"-      (Generated, _) ->-        "  generated " <> T.pack (stalePath stale) <> "  (exact generated banner missing; preserve and review)"-      (HoleStub, _) -> "  hole      " <> T.pack (stalePath stale) <> "  (hand-owned — preserve and review)"--sourceLanguageLabel :: SourceLanguage -> Text-sourceLanguageLabel sourceLanguage =-  sourceFormText sourceLanguage-    <> "/effective-v"-    <> languageVersionText (effectiveLanguageVersion sourceLanguage)--obligationKindLabel :: BindingObligationKind -> Text-obligationKindLabel BindingValue = "binding"-obligationKindLabel FixtureValue = "fixtures"-obligationKindLabel InitialValue = "initial-value"--renderBracketed :: [Text] -> Text-renderBracketed values = "[" <> T.intercalate ", " values <> "]"--renderMappingIdentity :: MappingIdentity -> Text-renderMappingIdentity StructuralMapping {mappingPackage, mappingModule, mappingType, mappingBindingSymbol, mappingBindingVersion} =-  "structural "-    <> mappingPackage-    <> ":"-    <> mappingModule-    <> "."-    <> mappingType-    <> " binding="-    <> mappingBindingSymbol-    <> " version="-    <> mappingBindingVersion-renderMappingIdentity OpaqueMapping {mappingPackage, mappingModule, mappingType, mappingCodecIdentity, mappingCodecVersion} =-  "opaque "-    <> mappingPackage-    <> ":"-    <> mappingModule-    <> "."-    <> mappingType-    <> " codec="-    <> mappingCodecIdentity-    <> " version="-    <> mappingCodecVersion-renderMappingIdentity NominalMapping {mappingNominalCategory, mappingNominalRepresentation, mappingPackage, mappingModule, mappingType, mappingBindingSymbol, mappingBindingVersion} =-  "nominal-"-    <> mappingNominalCategory-    <> " "-    <> mappingPackage-    <> ":"-    <> mappingModule-    <> "."-    <> mappingType-    <> " representation="-    <> mappingNominalRepresentation-    <> " binding="-    <> mappingBindingSymbol-    <> " version="-    <> mappingBindingVersion+    LedgerRead (..),+    WriteDisposition (..),+    GeneratedArtifactCategory (..),+    GeneratedArtifactImpact (..),+    GeneratedHaskellEditionImpact (..),+    GeneratedHaskellEditionUse (..),+    HoleUseForm (..),+    PreparedGeneratedHaskellEditionMigration,+    preparedGeneratedHaskellEditionImpact,+    StaleGeneratedEvidence (..),+    StaleModule (..),+    MappingDrift (..),+    QueryContractMigration (..),+    SourceLanguageDrift (..),+    ScaffoldReport (..),+    scaffoldServiceModules,+    scaffoldServiceModulesWithGoldens,+    scaffoldModules,+    scaffoldModulesWithGoldens,+    planIndexedServiceScaffold,+    planIndexedServiceScaffoldWithGoldens,+    planIndexedServiceScaffoldWithRuntimePackage,+    planIndexedServiceScaffoldWithRuntimePackageAndGoldens,+    executeServiceScaffold,+    executeServiceScaffoldWithRuntimePackage,+    executeServiceScaffoldWithRuntimePackageAndNameMigrations,+    executeServiceScaffoldWithRuntimePackageAndMigrations,+    executeScaffold,+    executeScaffoldWithLanguage,+    renderRefusals,+    renderScaffoldReport,+    checkedSemanticImpactSnapshot,+    semanticImpactForMappingDrift,+    generatedArtifactImpact,+    renderSemanticImpactReport,+    renderGeneratedArtifactImpact,+    renderRouterSelectionDrift,++    -- * Shared with whole-workspace scaffolding ("Keiro.Dsl.WorkspaceScaffold")++    --+    -- $shared+    planningGatePipeline,+    planningRefusalDiagnostics,+    checkIndexedServiceDiagnostics,+    inertNodesOf,+    renderInertNodeSection,+    withSidecarMovesApplied,+    originLine,+    pureRefusalsForService,+    auditGeneratedHaskell,+    missingGeneratedBanners,+    staleAgainst,+    PreparedSourceMove,+    preparedSourceMove,+    preflightSourceMoves,+    applyPreparedSourceMoves,+    preflightGeneratedHaskellEditionMigration,+    applyPreparedGeneratedHaskellEditionMigration,+    withGeneratedHaskellEditionSourceMoves,+    generatedHaskellEditionBackupRoot,+    readRecord,+    ledgerToMaybe,+    constraintPlanForService,+    mappingDrift,+    behaviorDrift,+    newBindingObligations,+    queryContractMigrations,+    obligationKindLabel,+    renderMappingIdentity,+  )+where++import Data.ByteString qualified as BS+import Data.List (sort, sortOn)+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Keiro.Dsl.BehaviorCoverage (BehaviorDerivationError, BehaviorKey (..), BehaviorRecordRow (..), behaviorRecordRows, deriveBehaviorRequirementsForService)+import Keiro.Dsl.BehaviorCoverage qualified as Behavior+import Keiro.Dsl.BehaviorSourceMap (BehaviorSourceFailure)+import Keiro.Dsl.BehaviorSourceMap qualified as BehaviorSource+import Keiro.Dsl.ConformancePackage+  ( ConformancePackageFailure,+    ConformancePackageReport,+    ConformanceServiceKey (StandaloneConformanceService),+    executePreparedConformancePackage,+    planConformancePackage,+    preflightConformancePackage,+    renderConformancePackageFailure,+    renderConformancePackageReport,+  )+import Keiro.Dsl.CoordinationImpact (RouterSelectionDrift, renderRouterSelectionDrift, routerSelectionDrift, routerSelectionSnapshots)+import Keiro.Dsl.ExplainBindings (BindingHole (..), BindingObligationKind (..), bindingHolesForService)+import Keiro.Dsl.FoldFingerprint (FoldSurfaceError, aggregateFoldSurfaceForService, renderFoldSurfaceError)+import Keiro.Dsl.GeneratedHaskellLanguage (idiomaticV2LabelMigrations)+import Keiro.Dsl.Goldens (GoldenPayload)+import Keiro.Dsl.Grammar (EmitNode (..), Loc (..), Node (..), OperationNode (..), PgmqDispatchNode (..), Spec (..))+import Keiro.Dsl.Harness (harnessForServiceWithGoldens, harnessProcess, harnessReadModelForService, harnessRouterForService, harnessWorkflow)+import Keiro.Dsl.HaskellName (currentGeneratedHaskellNamingEdition)+import Keiro.Dsl.HaskellName qualified as HaskellName+import Keiro.Dsl.HaskellSourceMove+import Keiro.Dsl.IdDomain (idDomainIdentitiesForService)+import Keiro.Dsl.LanguageVersion (SourceLanguage (..), effectiveLanguageVersion, languageVersionText, sourceFormText)+import Keiro.Dsl.Manifest (moduleNameOf, renderManifestForServiceWithFacade)+import Keiro.Dsl.MappedConsumer (ConsumerPlan (..), MappingIdentity (..), consumerPlanForService)+import Keiro.Dsl.NominalType (nominalEqualityIdentitiesForService)+import Keiro.Dsl.ProjectionMappedImpact (ProjectionMappedImpact, projectionMappedImpactForService, renderProjectionMappedImpact)+import Keiro.Dsl.ReadModelQueryContract+import Keiro.Dsl.RuntimePackage (RuntimePackageName)+import Keiro.Dsl.Scaffold+import Keiro.Dsl.ScaffoldRecord (ScaffoldModuleRoleRow (..), ScaffoldRecord (..), parseRecord, projectionCatalogFactsForService, recordFileName, renderRecord)+import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedService, checkedSpec, checkedTypeGraph, effectiveLanguageContract, legacyCheckedService)+import Keiro.Dsl.SemanticImpact+  ( MappedImpactDelta (..),+    MappedRootEvidence (..),+    SemanticImpactReport (..),+    SemanticImpactSnapshot (..),+    diffSemanticImpact,+    mappedConsequenceIdentity,+    mappedConsumerIdentity,+    mappedRootKindIdentity,+    semanticImpactForService,+    semanticImpactReport,+    semanticImpactSnapshot,+  )+import Keiro.Dsl.ServiceHarness (DuplicateServiceFactKey (..), serviceConformanceModuleName, serviceHarnessModule)+import Keiro.Dsl.SidecarMigration+import Keiro.Dsl.SidecarNames (contextCabalFragmentFileName, legacyContextRecordFileName)+import Keiro.Dsl.Source (SourcePoint (..), SourceSpan (..))+import Keiro.Dsl.SourceIndex (SemanticSourceIndex)+import Keiro.Dsl.StructuralConformance (structuralConformanceModule)+import Keiro.Dsl.TypeGraph (MappedKey (..), TypeGraph (..), UseSite (..))+import Keiro.Dsl.Validate (Diagnostic (..), DiagnosticCode (..), Severity (..), validateService)+import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, removeFile, renameFile)+import System.FilePath (takeDirectory, (</>))+import Text.Read (readMaybe)++-- $shared+-- These are the pieces whole-workspace scaffolding reuses verbatim rather than+-- reimplementing, so a workspace and a single spec can never disagree about what+-- counts as a refusal, what counts as stale, or how an identity renders.+-- "Keiro.Dsl.WorkspaceScaffold" cannot live in this module because+-- "Keiro.Dsl.Workspace" already imports it (its cross-member collision check asks+-- the planner), so the seam is exports rather than shared privates.++data Refusal+  = PathCollision !FilePath ![Text]+  | FirewallBreach ![(FilePath, Text, Int)]+  | LoweringRefusal ![Text]+  | MissingGeneratedBanner ![FilePath]+  | ImportCycle ![Text]+  | BehaviorRefusal ![BehaviorDerivationError]+  | BehaviorSourceRefusal ![BehaviorSourceFailure]+  | -- | Persisted fold identity could not be resolved canonically.+    FoldSurfaceRefusal !FoldSurfaceError+  | -- | Source provenance and semantic planning selected different contracts.+    --       This is an internal/API misuse refusal and is detected before writes.+    SemanticContractMismatch !Text+  | -- | Golden payload fixtures found beside a workspace member that the one+    --       workspace golden root does not have. Raised only by the workspace path.+    GoldenRootDivergence !FilePath ![FilePath]+  | DuplicateConformanceFactKeys ![DuplicateServiceFactKey]+  | ConformancePackageRefusal !ConformancePackageFailure+  | GeneratedNameInvariantViolation ![Text]+  | NameMigrationRequired ![SourceMove]+  | NameMigrationRefusal ![Text]+  | SidecarMigrationRequired ![SidecarMove]+  | SidecarMigrationRefusal ![Text]+  | GeneratedHaskellEditionRequired !GeneratedHaskellEditionImpact+  | GeneratedHaskellEditionRefusal ![Text]+  | LedgerUnreadable !FilePath+  | -- | Not a refusal on its own: an accompanying note that the run had already+    --       applied its sidecar renames before a later gate refused. Every other+    --       refusal says "nothing was written", which without this note is false.+    --       The renames are idempotent and forward-consistent, so re-running after+    --       fixing the refusal is correct and needs no undo.+    SidecarMovesAlreadyApplied ![SidecarMove]+  deriving stock (Eq, Show)++data LedgerRead a+  = LedgerAbsent+  | LedgerParsed !a+  | LedgerReadUnreadable !FilePath+  deriving stock (Eq, Show)++data GeneratedHaskellEditionUse = GeneratedHaskellEditionUse+  { path :: !FilePath,+    line :: !Int,+    current :: !Text,+    replacement :: !Text,+    form :: !HoleUseForm+  }+  deriving stock (Eq, Ord, Show)++data HoleUseForm+  = PrefixApplication+  | QualifiedApplication+  | RecordDotRenamed+  | RecordFieldBinding+  | OperatorOperand+  deriving stock (Eq, Ord, Show)++data GeneratedHaskellEditionImpact = GeneratedHaskellEditionImpact+  { fromEdition :: !HaskellName.GeneratedHaskellNamingEdition,+    generatedPaths :: ![FilePath],+    sidecarPaths :: ![FilePath],+    handOwnedUses :: ![GeneratedHaskellEditionUse]+  }+  deriving stock (Eq, Show)++data PreparedGeneratedHaskellEditionMigration = PreparedGeneratedHaskellEditionMigration+  { impact :: !GeneratedHaskellEditionImpact,+    backups :: ![(FilePath, FilePath)],+    reportPath :: !FilePath,+    reportText :: !Text,+    sourceMoves :: ![SourceMove]+  }+  deriving stock (Eq, Show)++preparedGeneratedHaskellEditionImpact :: PreparedGeneratedHaskellEditionMigration -> GeneratedHaskellEditionImpact+preparedGeneratedHaskellEditionImpact = (.impact)++-- | What one module write did. 'Unchanged' means an existing Generated module+-- already had identical bytes, or is reported by the workspace write path under+-- the same rule.+data WriteDisposition = Overwritten | Created | Skipped | Unchanged+  deriving stock (Eq, Show)++data GeneratedArtifactCategory+  = AggregateGeneratedArtifact+  | ServiceStructuralConformanceArtifact+  | BehaviorSourceMapArtifact+  | OtherGeneratedArtifact+  deriving stock (Eq, Ord, Show)++data GeneratedArtifactImpact = GeneratedArtifactImpact+  { category :: !GeneratedArtifactCategory,+    role :: !ModuleRole,+    path :: !FilePath,+    disposition :: !WriteDisposition+  }+  deriving stock (Eq, Show)++data StaleGeneratedEvidence+  = ExactGeneratedBannerPresent+  | ExactGeneratedBannerMissing+  deriving stock (Eq, Show)++data StaleModule = StaleModule+  { kind :: !ModuleKind,+    path :: !FilePath,+    generatedEvidence :: !(Maybe StaleGeneratedEvidence)+  }+  deriving stock (Eq, Show)++data MappingDrift = MappingDrift+  { specName :: !Text,+    previous :: !(Maybe MappingIdentity),+    current :: !(Maybe MappingIdentity)+  }+  deriving stock (Eq, Show)++data SourceLanguageDrift = SourceLanguageDrift+  { previous :: !SourceLanguage,+    current :: !SourceLanguage+  }+  deriving stock (Eq, Show)++data ScaffoldReport = ScaffoldReport+  { specPath :: !FilePath,+    outDir :: !FilePath,+    context :: !Context,+    dispositions :: ![(ScaffoldModule, WriteDisposition)],+    inertNodes :: ![(Text, Text)],+    manifestPath :: !FilePath,+    recordPath :: !FilePath,+    previousSpecPath :: !(Maybe Text),+    stale :: ![StaleModule],+    consumerPlan :: !ConsumerPlan,+    constraintPlan :: ![Text],+    mappingDrift :: ![MappingDrift],+    queryContractBaselineUnavailable :: !Bool,+    queryContractDrift :: ![QueryContractDrift],+    queryContractMigrations :: ![QueryContractMigration],+    semanticImpact :: !SemanticImpactReport,+    routerSelectionDrift :: ![RouterSelectionDrift],+    projectionMappedImpact :: !(Maybe ProjectionMappedImpact),+    generatedArtifactImpact :: ![GeneratedArtifactImpact],+    sourceLanguageDrift :: !(Maybe SourceLanguageDrift),+    newHoles :: ![BindingHole],+    addedBehavior :: ![BehaviorRecordRow],+    removedBehavior :: ![BehaviorRecordRow],+    obsoleteOutputHooks :: ![(Text, Text)],+    conformancePackage :: !(Maybe ConformancePackageReport),+    nameMoves :: ![SourceMove],+    sidecarMoves :: ![SidecarMove]+  }+  deriving stock (Eq, Show)++data QueryContractMigration = QueryContractMigration+  { owner :: !Text,+    path :: !FilePath,+    requiredImport :: !Text+  }+  deriving stock (Eq, Show)++-- | Produce the complete in-memory module set under a checked semantic+-- contract. Keeping this registry in one place prevents the CLI and tests from+-- drifting apart.+scaffoldServiceModules :: Context -> CheckedService -> [ScaffoldModule]+scaffoldServiceModules = scaffoldServiceModulesWithGoldens []++scaffoldServiceModulesWithGoldens :: [GoldenPayload] -> Context -> CheckedService -> [ScaffoldModule]+scaffoldServiceModulesWithGoldens goldens = scaffoldServiceModulesWithBehaviorSource goldens []++scaffoldServiceModulesWithBehaviorSource :: [GoldenPayload] -> [BehaviorSource.BehaviorSourceEntry] -> Context -> CheckedService -> [ScaffoldModule]+scaffoldServiceModulesWithBehaviorSource goldens sourceEntries ctx service =+  map modernizeScaffoldModule $+    structuralConformanceModules ctx service+      <> maybe [] pure (behaviorSourceMapModule ctx sourceEntries)+      <> scaffoldStructuralForService ctx service+      <> scaffoldReplayAudit ctx spec+      <> scaffoldProjectionCatalogForService ctx service+      <> concat+        [ case node of+            NAggregate agg -> scaffoldAggregateForService ctx service agg <> harnessForServiceWithGoldens goldens ctx service agg+            NProcess process -> scaffoldProcess ctx process <> harnessProcess ctx process+            NRouter router -> scaffoldRouterForService ctx service router <> harnessRouterForService ctx service router+            NContract contract -> scaffoldContractForService ctx service contract+            NIntake intake -> scaffoldIntake ctx intake+            NPublisher publisher -> scaffoldPublisher ctx publisher+            NWorkqueue workqueue -> scaffoldWorkqueueForService ctx service workqueue+            NReadModel readModel ->+              let resolved = resolveCatalogReadModel spec readModel+               in scaffoldReadModelForService ctx service resolved <> harnessReadModelForService ctx service resolved+            NProjectionTarget _ -> []+            NRebuildGroup _ -> []+            NProjectionRevision _ -> []+            NExternalRead _ -> []+            NProjectionOwner _ -> []+            NWorkflow workflow -> harnessWorkflow ctx workflow+            NEmit _ -> []+            NPgmqDispatch _ -> []+            NOperation _ -> []+        | node <- (.nodes) spec+        ]+  where+    spec = checkedSpec service++structuralConformanceModules :: Context -> CheckedService -> [ScaffoldModule]+structuralConformanceModules ctx service = case structuralConformanceModule ctx service of+  Left failures -> error ("checked structural conformance planning failed: " <> show failures)+  Right Nothing -> []+  Right (Just moduleValue) -> [moduleValue]++-- | Compatibility wrapper that explicitly selects legacy/version-1 semantics.+scaffoldModules :: Context -> Spec -> [ScaffoldModule]+scaffoldModules = scaffoldModulesWithGoldens []++scaffoldModulesWithGoldens :: [GoldenPayload] -> Context -> Spec -> [ScaffoldModule]+scaffoldModulesWithGoldens goldens ctx = scaffoldServiceModulesWithGoldens goldens ctx . legacyCheckedService++-- | Run every pure refusal gate under the effective semantic contract. A+-- successful result is the exact write set; a refusal has no write set and+-- therefore cannot be accidentally executed.+planIndexedServiceScaffold :: SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planIndexedServiceScaffold = planIndexedServiceScaffoldWithRuntimePackage Nothing++planIndexedServiceScaffoldWithGoldens :: [GoldenPayload] -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planIndexedServiceScaffoldWithGoldens goldens = planIndexedServiceScaffoldWithRuntimePackageAndGoldens goldens Nothing++-- | Add the one service-level conformance facade only when the runtime package+-- is explicitly configured. The package name itself is build metadata; facade+-- naming depends solely on the service context and placement policy.+planIndexedServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planIndexedServiceScaffoldWithRuntimePackage = planIndexedServiceScaffoldWithRuntimePackageAndGoldens []++planIndexedServiceScaffoldWithRuntimePackageAndGoldens :: [GoldenPayload] -> Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> Either [Refusal] [ScaffoldModule]+planIndexedServiceScaffoldWithRuntimePackageAndGoldens goldens runtimePackage sourceIndex ctx service = do+  -- Preserve the established refusal precedence. Structural/path/import and+  -- behavior-derivation defects are decidable without exact provenance and+  -- must not be hidden by a later source-anchor join failure.+  _ <- planningGatePipeline ctx service baseModulePlan (Right ())+  planningGatePipeline ctx service completeModulePlan (Right ())+  where+    facadeModules = case runtimePackage of+      Nothing -> Right []+      Just _ -> fmap pure (serviceHarnessModule ctx service)+    baseModulePlan = case facadeModules of+      Left duplicates -> Left [DuplicateConformanceFactKeys duplicates]+      Right facades ->+        Right $+          stampGeneratedModules+            (checkedLanguageContract service)+            (scaffoldServiceModulesWithGoldens goldens ctx service <> facades)+    completeModulePlan =+      case (behaviorSourcePlan, facadeModules) of+        (Left refusals, _) -> Left refusals+        (_, Left duplicates) -> Left [DuplicateConformanceFactKeys duplicates]+        (Right sourceEntries, Right facades) ->+          Right $+            stampGeneratedModules+              (checkedLanguageContract service)+              (scaffoldServiceModulesWithBehaviorSource goldens sourceEntries ctx service <> facades)+    behaviorSourcePlan = do+      requirements <- either (Left . pure . BehaviorRefusal) Right (deriveBehaviorRequirementsForService service)+      either (Left . pure . BehaviorSourceRefusal) Right (BehaviorSource.planBehaviorSourceMap requirements sourceIndex)++-- | The one pure scaffold-planning gate sequence. Both scaffold planners and+-- both check paths consume this function, so the first reported refusal cannot+-- drift by input shape.+planningGatePipeline ::+  Context ->+  CheckedService ->+  Either [Refusal] [ScaffoldModule] ->+  Either [Refusal] () ->+  Either [Refusal] [ScaffoldModule]+planningGatePipeline ctx service modulePlan packagePlan =+  case traverse (aggregateFoldSurfaceForService service) [aggregate | NAggregate aggregate <- (.nodes) spec] of+    Left surfaceError -> Left [FoldSurfaceRefusal surfaceError]+    Right _ -> case scaffoldRefusalsForService service of+      lowering@(_ : _) -> Left [LoweringRefusal lowering]+      [] -> case modulePlan of+        Left refusals -> Left refusals+        Right modules -> case packagePlan of+          Left refusals -> Left refusals+          Right () -> case pureRefusalsForService ctx service modules of+            [] -> Right modules+            refusals -> Left refusals+  where+    spec = checkedSpec service++-- | The nodes a spec declares that contribute no generated module.+--+-- They are still parsed, validated, and diff-classified; naming them in the+-- scaffold report is what stops an author from concluding the toolchain lost+-- their declaration. Shared by the single-spec and workspace planners so a+-- workspace — the recommended layout — reports exactly what one spec reports.+inertNodesOf :: Spec -> [(Text, Text)]+inertNodesOf spec =+  [ (kindLabel, nodeName)+  | node <- (.nodes) spec,+    (kindLabel, nodeName) <- case node of+      NEmit emitNode -> [("emit", (.name) emitNode)]+      NPgmqDispatch dispatchNode -> [("dispatch", (.name) dispatchNode)]+      NOperation operationNode -> [("operation", (.name) operationNode)]+      _ -> []+  ]++-- | The report line naming 'inertNodesOf', or nothing when every declaration+-- produced a module.+renderInertNodeSection :: [(Text, Text)] -> [Text]+renderInertNodeSection = \case+  [] -> []+  nodes ->+    [ "no-modules: "+        <> T.intercalate ", " [kindLabel <> " " <> nodeName | (kindLabel, nodeName) <- nodes]+        <> " (validated and diff-classified; no generated modules)"+    ]++-- | Validate a checked service, then run the shared planning gates unless an+-- error makes module generation unsound. 'GeneratedOccurrenceCollision' is the+-- deliberate exception: the workspace path already plans through it so the+-- stronger whole-path collision can cite every claimant. Existing diagnostics+-- retain their order and planning diagnostics follow them.+checkIndexedServiceDiagnostics :: Maybe RuntimePackageName -> SemanticSourceIndex -> Context -> CheckedService -> [Diagnostic]+checkIndexedServiceDiagnostics runtimePackage sourceIndex ctx service+  | any blocksPlanning validationDiagnostics = validationDiagnostics+  | otherwise =+      validationDiagnostics+        <> case planIndexedServiceScaffoldWithRuntimePackage runtimePackage sourceIndex ctx service of+          Right _ -> []+          Left refusals -> planningRefusalDiagnostics refusals+  where+    validationDiagnostics = validateService service+    blocksPlanning diagnostic =+      (.severity) diagnostic == Error+        && (.code) diagnostic /= GeneratedOccurrenceCollision++-- | Present pure planning refusals through check's stable located diagnostic+-- vocabulary. Planner-invariant failures retain the detailed scaffold refusal+-- text in their message while receiving one machine code.+planningRefusalDiagnostics :: [Refusal] -> [Diagnostic]+planningRefusalDiagnostics = concatMap diagnosticsFor+  where+    diagnosticsFor (PathCollision path origins) = [pathCollisionDiagnostic path origins]+    diagnosticsFor (ImportCycle path) =+      [ planningError 1 GeneratedImportCycle $+          "generated/consumer import cycle "+            <> T.intercalate " -> " path+            <> "; keep bindings in a leaf module that imports only Structural.Shape.* and Keiro.Codec.Structural"+      ]+    diagnosticsFor (BehaviorRefusal errors) =+      [ planningError (behaviorErrorLine behaviorError) BehaviorDerivationInvalid $+          "behavior obligations cannot be derived soundly: " <> T.pack (show behaviorError)+      | behaviorError <- errors+      ]+    diagnosticsFor (BehaviorSourceRefusal failures) =+      [ planningError (behaviorSourceFailureLine failure) (behaviorSourceDiagnosticCode failure) $+          "behavior source map cannot be planned for "+            <> Behavior.unBehaviorKey ((.key) failure)+            <> " ("+            <> (.aggregate) failure+            <> ":"+            <> (.state) failure+            <> " -- "+            <> (.command) failure+            <> ", subject="+            <> T.pack (show ((.sourceSubject) failure))+            <> "): "+            <> (.message) failure+      | failure <- failures+      ]+    diagnosticsFor (DuplicateConformanceFactKeys duplicates) =+      [ planningError 1 ConformanceFactKeyCollision $+          "normalized service conformance fact key '"+            <> (.duplicateServiceFactKey) duplicate+            <> "' is produced more than once"+      | duplicate <- duplicates+      ]+    diagnosticsFor refusal =+      [ planningError 1 GeneratedPlanningInvariantViolation $+          "validated service failed an internal scaffold-planning invariant: "+            <> T.intercalate " | " (renderRefusals [refusal])+      ]++    pathCollisionDiagnostic path origins =+      Diagnostic+        { line = primaryLine,+          severity = Error,+          code = GeneratedPathCollision,+          relatedLocations =+            [ (claimLine, "claimed here by " <> claimOrigin)+            | (claimLine, claimOrigin) <- remainingClaims+            ],+          message =+            "generated module path '"+              <> T.pack path+              <> "' is claimed more than once; on a case-insensitive filesystem these are one file; claimants: "+              <> T.intercalate "; " origins+        }+      where+        orderedClaims = reverse (sortOn fst [(claimLine, claimOrigin) | claimOrigin <- origins, Just claimLine <- [originLine claimOrigin]])+        (primaryLine, remainingClaims) = case orderedClaims of+          (claimLine, _) : rest -> (claimLine, rest)+          [] -> (1, [])++    behaviorErrorLine (Behavior.DuplicateBehaviorIdentity _ locations) = maximum (1 : map (.unLoc) locations)+    behaviorErrorLine _ = 1++    behaviorSourceFailureLine failure = case (.span) failure of+      Just SourceSpan {start = SourcePoint {line = sourceLine}} -> sourceLine+      Nothing -> 1+    behaviorSourceDiagnosticCode failure = case (.code) failure of+      BehaviorSource.BehaviorSourceAnchorMissing -> BehaviorSourceAnchorMissing+      BehaviorSource.BehaviorSourceAnchorInexact -> BehaviorSourceAnchorInexact+      BehaviorSource.BehaviorSourceAnchorCollision -> BehaviorSourceAnchorCollision++    planningError diagnosticLine diagnosticCode diagnosticMessage =+      Diagnostic+        { line = diagnosticLine,+          severity = Error,+          code = diagnosticCode,+          relatedLocations = [],+          message = diagnosticMessage+        }++-- | Recover the source line embedded in a generated module's origin text,+-- which scaffold formats as @<kind> <name> (line N)@.+originLine :: Text -> Maybe Int+originLine originText = do+  withoutClose <- T.stripSuffix ")" originText+  let (before, after) = T.breakOnEnd " (line " withoutClose+  if T.null before then Nothing else readMaybe (T.unpack after)++-- | Every pure refusal gate, over an already-built module set: case-folded path+-- collisions, generated\/consumer collisions and import cycles, firewall breaches,+-- and lowering refusals. Whole-workspace planning builds its module set from the+-- merged spec and then runs exactly this, so no gate can apply to one input shape+-- and not the other.+pureRefusalsForService :: Context -> CheckedService -> [ScaffoldModule] -> [Refusal]+pureRefusalsForService ctx service modules =+  collisionRefusals modules+    <> dependencyRefusalsForService ctx service modules+    <> [FirewallBreach breaches | not (null breaches)]+    <> [GeneratedNameInvariantViolation namingViolations | not (null namingViolations)]+    <> [LoweringRefusal lowering | let lowering = scaffoldRefusalsForService service, not (null lowering)]+    <> [BehaviorRefusal errors | Left errors <- [deriveBehaviorRequirementsForService service]]+  where+    breaches = firewallBreaches modules+    namingViolations = generatedNameInvariantViolations modules++generatedNameInvariantViolations :: [ScaffoldModule] -> [Text]+generatedNameInvariantViolations = concatMap auditGeneratedHaskell++-- | Inventory and check declarations in one generated source file.  The+-- lexical mask keeps comments and literals out of the declaration inventory;+-- this is deliberately a final defense after the typed naming plan, so a+-- literal template declaration cannot bypass the checked constructors.+auditGeneratedHaskell :: ScaffoldModule -> [Text]+auditGeneratedHaskell scaffoldModule = lexicalErrors <> declarationErrors <> duplicateDeclarationErrors <> occurrenceErrors+  where+    expectedModule = moduleNameOf ((.path) scaffoldModule)+    (lexicalErrors, codeSource) = case maskNonCode ((.text) scaffoldModule) of+      Left message -> ([prefix 1 <> message], "")+      Right masked -> ([], masked)+    sourceLines = zip [1 :: Int ..] (T.lines codeSource)+    declarationErrors = moduleDeclarationErrors <> moduleSegmentErrors+    moduleDeclarationErrors = case declaredModuleName codeSource of+      Nothing -> [T.pack ((.path) scaffoldModule) <> ": missing Haskell module declaration"]+      Just declared+        | declared == expectedModule -> []+        | otherwise ->+            [ T.pack ((.path) scaffoldModule)+                <> ": declares "+                <> declared+                <> " but its planned module is "+                <> expectedModule+            ]+    moduleSegmentErrors =+      [ prefix 1 <> "module segment '" <> segment <> "' is not UpperCamelCase"+      | segment <- T.splitOn "." expectedModule,+        isLeftName (HaskellName.checkedModuleSegment (auditSite HaskellName.NodeModuleSite segment 1) segment)+      ]+    occurrenceErrors =+      concat+        [ checkCandidates lineNumber (signatureCandidates sourceLine)+            <> checkCandidates lineNumber (typeCandidates sourceLine)+            <> checkCandidates lineNumber (constructorCandidates sourceLine)+            <> checkCandidates lineNumber (topLevelValueCandidates sourceLine)+        | (lineNumber, sourceLine) <- sourceLines+        ]++    duplicateDeclarationErrors = duplicateErrors "top-level type signature" signatureCandidates <> duplicateErrors "top-level type declaration" typeCandidates+    duplicateErrors label candidates =+      [ prefix laterLine+          <> "repeated "+          <> label+          <> " '"+          <> candidate+          <> "' (first declared at line "+          <> tshow firstLine+          <> ")"+      | (candidate, declarationLines) <- Map.toAscList declarations,+        firstLine : laterLines <- [declarationLines],+        laterLine <- laterLines+      ]+      where+        declarations =+          Map.fromListWith+            (flip (++))+            [ (candidate, [lineNumber])+            | (lineNumber, sourceLine) <- sourceLines,+              sourceLine == T.stripStart sourceLine,+              candidate <- candidates sourceLine+            ]++    checkCandidates lineNumber = concatMap (checkCandidate lineNumber)+    checkCandidate lineNumber candidate+      | T.null candidate = []+      | asciiUpperInitial candidate =+          [prefix lineNumber <> "generated declaration '" <> candidate <> "' is not UpperCamelCase" | isLeftName (HaskellName.checkedUpperOccurrence (auditSite HaskellName.GeneratedTypeSite candidate lineNumber) candidate)]+      | otherwise =+          [prefix lineNumber <> "generated declaration '" <> candidate <> "' is not lowerCamelCase" | isLeftName (HaskellName.checkedLowerOccurrence (auditSite HaskellName.GeneratedValueSite candidate lineNumber) candidate)]++    prefix lineNumber = T.pack ((.path) scaffoldModule) <> ":" <> tshow lineNumber <> ": "++    auditSite kind candidate lineNumber =+      HaskellName.NameSite+        { HaskellName.kind = kind,+          HaskellName.logicalName = candidate,+          HaskellName.owner = T.pack ((.path) scaffoldModule),+          HaskellName.line = lineNumber+        }++isLeftName :: Either left right -> Bool+isLeftName = \case Left _ -> True; Right _ -> False++declaredModuleName :: Text -> Maybe Text+declaredModuleName source =+  case [T.takeWhile moduleCharacter (T.drop 7 sourceLine) | sourceLine <- T.lines source, "module " `T.isPrefixOf` sourceLine] of+    declaration : _ | not (T.null declaration) -> Just declaration+    _ -> Nothing+  where+    moduleCharacter character = identifierCharacter character || character == '.'++signatureCandidates :: Text -> [Text]+signatureCandidates sourceLine+  | T.null suffix || T.any (`elem` ['=', '(', ')', '[', ']']) prefix = []+  | otherwise = filter isIdentifier (map T.strip (T.splitOn "," prefix))+  where+    (prefix, suffix) = T.breakOn "::" (T.strip sourceLine)++typeCandidates :: Text -> [Text]+typeCandidates sourceLine = case T.words (T.strip sourceLine) of+  keyword : candidate : _+    | keyword `elem` ["data", "newtype", "type"], candidate /= "family", candidate /= "instance" -> [cleanIdentifier candidate]+  _ -> []++constructorCandidates :: Text -> [Text]+constructorCandidates sourceLine+  | "|" `T.isPrefixOf` stripped = takeFollowingIdentifier (T.drop 1 stripped)+  | any (`T.isPrefixOf` stripped) ["data ", "newtype "] = takeFollowingIdentifier (T.drop 1 (snd (T.breakOn "=" stripped)))+  | otherwise = []+  where+    stripped = T.strip sourceLine+    takeFollowingIdentifier value = case T.words value of+      candidate : _ | asciiUpperInitial (cleanIdentifier candidate) -> [cleanIdentifier candidate]+      _ -> []++topLevelValueCandidates :: Text -> [Text]+topLevelValueCandidates sourceLine+  | T.null sourceLine || T.head sourceLine == ' ' || T.head sourceLine == '\t' = []+  | T.null suffix = []+  | otherwise = case T.words prefix of+      candidate : _+        | candidate `notElem` declarationKeywords,+          isIdentifier candidate ->+            [candidate]+      _ -> []+  where+    (prefix, suffix) = T.breakOn "=" sourceLine+    declarationKeywords = ["data", "newtype", "type", "class", "instance", "module", "import", "deriving", "infix", "infixl", "infixr"]++cleanIdentifier :: Text -> Text+cleanIdentifier = T.takeWhile identifierCharacter . T.dropWhile (not . identifierCharacter)++isIdentifier :: Text -> Bool+isIdentifier candidate = not (T.null candidate) && T.all identifierCharacter candidate++identifierCharacter :: Char -> Bool+identifierCharacter character =+  (character >= 'A' && character <= 'Z')+    || (character >= 'a' && character <= 'z')+    || (character >= '0' && character <= '9')+    || character == '_'+    || character == '\''++asciiUpperInitial :: Text -> Bool+asciiUpperInitial candidate = case T.uncons candidate of+  Just (first, _) -> first >= 'A' && first <= 'Z'+  Nothing -> False++data AuditLexState = AuditCode | AuditLineComment | AuditBlockComment !Int | AuditString | AuditCharacter++maskNonCode :: Text -> Either Text Text+maskNonCode = fmap T.pack . go AuditCode . T.unpack+  where+    go state input = case (state, input) of+      (AuditCode, []) -> Right []+      (AuditLineComment, []) -> Right []+      (AuditBlockComment _, []) -> Left "unterminated block comment in generated source"+      (AuditString, []) -> Left "unterminated string literal in generated source"+      (AuditCharacter, []) -> Left "unterminated character literal in generated source"+      (AuditCode, '-' : '-' : rest) -> prependSpaces 2 <$> go AuditLineComment rest+      (AuditCode, '{' : '-' : rest) -> prependSpaces 2 <$> go (AuditBlockComment 1) rest+      (AuditCode, '"' : rest) -> (' ' :) <$> go AuditString rest+      (AuditCode, '\'' : rest)+        | looksLikeCharacterLiteral rest -> (' ' :) <$> go AuditCharacter rest+      (AuditCode, character : rest) -> (character :) <$> go AuditCode rest+      (AuditLineComment, '\n' : rest) -> ('\n' :) <$> go AuditCode rest+      (AuditLineComment, _ : rest) -> (' ' :) <$> go AuditLineComment rest+      (AuditBlockComment depth, '{' : '-' : rest) -> prependSpaces 2 <$> go (AuditBlockComment (depth + 1)) rest+      (AuditBlockComment 1, '-' : '}' : rest) -> prependSpaces 2 <$> go AuditCode rest+      (AuditBlockComment depth, '-' : '}' : rest) -> prependSpaces 2 <$> go (AuditBlockComment (depth - 1)) rest+      (AuditBlockComment depth, '\n' : rest) -> ('\n' :) <$> go (AuditBlockComment depth) rest+      (AuditBlockComment depth, _ : rest) -> (' ' :) <$> go (AuditBlockComment depth) rest+      (AuditString, '\\' : _escaped : rest) -> prependSpaces 2 <$> go AuditString rest+      (AuditString, '"' : rest) -> (' ' :) <$> go AuditCode rest+      (AuditString, '\n' : _) -> Left "newline in generated string literal"+      (AuditString, _ : rest) -> (' ' :) <$> go AuditString rest+      (AuditCharacter, '\\' : _escaped : rest) -> prependSpaces 2 <$> go AuditCharacter rest+      (AuditCharacter, '\'' : rest) -> (' ' :) <$> go AuditCode rest+      (AuditCharacter, '\n' : _) -> Left "newline in generated character literal"+      (AuditCharacter, _ : rest) -> (' ' :) <$> go AuditCharacter rest++    prependSpaces count suffix = replicate count ' ' <> suffix+    looksLikeCharacterLiteral = \case+      '\\' : _escaped : '\'' : _ -> True+      _character : '\'' : _ -> True+      _ -> False++dependencyRefusalsForService :: Context -> CheckedService -> [ScaffoldModule] -> [Refusal]+dependencyRefusalsForService ctx service modules = collisionWithConsumers <> namespaceCycles+  where+    plan = consumerPlanForService service+    generatedByName = Map.fromList [(moduleNameOf ((.path) moduleValue), moduleValue) | moduleValue <- modules, (.kind) moduleValue == Generated]+    collisionWithConsumers =+      [ PathCollision+          ((.path) generated)+          [(.origin) generated, "consumer module " <> consumerModule]+      | consumerModule <- (.modules) plan,+        Just generated <- [Map.lookup consumerModule generatedByName]+      ]+    namespaceCycles =+      [ ImportCycle [importer, consumerModule, importer]+      | consumerModule <- (.modules) plan,+        generatedNamespaceOwned ctx consumerModule,+        importer <- take 1 (importersOf consumerModule modules <> [contextGeneratedRoot ctx])+      ]++generatedNamespaceOwned :: Context -> Text -> Bool+generatedNamespaceOwned ctx consumerModule = case (.placement) ctx of+  GeneratedPrefix -> contextGeneratedRoot ctx `T.isPrefixOf` consumerModule+  CollocatedLeaf ->+    (root <> contextSegment <> ".") `T.isPrefixOf` consumerModule+      && ".Generated" `T.isInfixOf` consumerModule+  where+    root = if T.null ((.moduleRoot) ctx) then "" else (.moduleRoot) ctx <> "."+    contextSegment = pascalFromKebab ((.name) ctx)++contextGeneratedRoot :: Context -> Text+contextGeneratedRoot ctx = case (.placement) ctx of+  GeneratedPrefix -> root <> "Generated." <> contextSegment+  CollocatedLeaf -> root <> contextSegment <> ".Generated"+  where+    root = if T.null ((.moduleRoot) ctx) then "" else (.moduleRoot) ctx <> "."+    contextSegment = pascalFromKebab ((.name) ctx)++importersOf :: Text -> [ScaffoldModule] -> [Text]+importersOf imported =+  map (moduleNameOf . (.path))+    . filter (any (importsModule imported) . T.lines . (.text))++importsModule :: Text -> Text -> Bool+importsModule expected line = case T.words (T.strip line) of+  "import" : rest -> expected `elem` rest+  _ -> False++collisionRefusals :: [ScaffoldModule] -> [Refusal]+collisionRefusals modules =+  [ PathCollision ((.path) first) (map (.origin) (first : rest))+  | first : rest <- Map.elems grouped,+    not (null rest)+  ]+  where+    grouped =+      Map.fromListWith+        (flip (<>))+        [(T.toCaseFold (T.pack ((.path) m)), [m]) | m <- modules]++generatedHaskellEditionBackupRoot :: HaskellName.GeneratedHaskellNamingEdition -> FilePath+generatedHaskellEditionBackupRoot fromEdition =+  ".keiro-dsl-generated-haskell-migrations"+    </> ( T.unpack (HaskellName.renderGeneratedHaskellNamingEdition fromEdition)+            <> "-to-"+            <> T.unpack (HaskellName.renderGeneratedHaskellNamingEdition HaskellName.currentGeneratedHaskellNamingEdition)+        )++preflightGeneratedHaskellEditionMigration :: FilePath -> Maybe HaskellName.GeneratedHaskellNamingEdition -> [(ModuleKind, FilePath)] -> [FilePath] -> IO (Either [Text] (Maybe PreparedGeneratedHaskellEditionMigration))+preflightGeneratedHaskellEditionMigration out previousEdition recordedFiles sidecars+  | previousEdition == Nothing || previousEdition == Just HaskellName.currentGeneratedHaskellNamingEdition = pure (Right Nothing)+  | otherwise = do+      let fromEdition = maybe HaskellName.LegacyNamingV1 id previousEdition+          backupRoot = generatedHaskellEditionBackupRoot fromEdition+          generatedPaths = sort [path | (Generated, path) <- recordedFiles]+          handOwnedPaths = sort [path | (HoleStub, path) <- recordedFiles]+          sidecarPaths = sort sidecars+          sourcePaths = generatedPaths <> sidecarPaths+      existingSources <- fmap (map fst . filter snd) (mapM existing sourcePaths)+      let labels = map fst idiomaticV2LabelMigrations+      uses <- fmap (sort . concat) (mapM (scanFile labels) handOwnedPaths)+      let impact = GeneratedHaskellEditionImpact fromEdition generatedPaths sidecarPaths uses+          backups = [(path, backupRoot </> path) | path <- existingSources]+          reportPath = backupRoot </> "remediation-report.txt"+          reportText = renderGeneratedHaskellEditionRemediation impact []+      conflicts <- fmap concat (mapM checkBackup backups)+      pure $+        if null conflicts+          then Right (Just (PreparedGeneratedHaskellEditionMigration impact backups reportPath reportText []))+          else Left conflicts+  where+    relative path = out </> path+    existing path = do+      exists <- doesFileExist (relative path)+      pure (path, exists)+    checkBackup (sourcePath, backupPath) = do+      exists <- doesFileExist (relative backupPath)+      if not exists+        then pure []+        else do+          sourceBytes <- BS.readFile (relative sourcePath)+          backupBytes <- BS.readFile (relative backupPath)+          pure ["edition backup conflict for " <> T.pack sourcePath <> ": " <> T.pack backupPath <> " contains different bytes" | sourceBytes /= backupBytes]+    scanFile labels path = do+      exists <- doesFileExist (relative path)+      if not exists+        then pure []+        else do+          contents <- TIO.readFile (relative path)+          pure+            [ GeneratedHaskellEditionUse path lineNumber label (replacementFor label form) form+            | (lineNumber, sourceLine) <- zip [1 ..] (T.lines contents),+              label <- labels,+              form <- holeUsesOnLine label (replacementLabel label) sourceLine+            ]+    replacementLabel label = maybe label id (lookup label idiomaticV2LabelMigrations)+    replacementFor label = \case+      RecordFieldBinding -> replacementLabel label <> " = ..."+      RecordDotRenamed -> "record." <> replacementLabel label+      _ ->+        "record."+          <> replacementLabel label+          <> " (or a positional constructor pattern for dual-edition code)"++applyPreparedGeneratedHaskellEditionMigration :: FilePath -> Maybe PreparedGeneratedHaskellEditionMigration -> IO ()+applyPreparedGeneratedHaskellEditionMigration _ Nothing = pure ()+applyPreparedGeneratedHaskellEditionMigration out (Just prepared) = do+  mapM_ copyBackup ((.backups) prepared)+  let reportPath = out </> (.reportPath) prepared+  createDirectoryIfMissing True (takeDirectory reportPath)+  TIO.writeFile reportPath ((.reportText) prepared)+  where+    copyBackup (sourcePath, backupPath) = do+      let source = out </> sourcePath+          backup = out </> backupPath+      backupExists <- doesFileExist backup+      if backupExists+        then pure ()+        else do+          createDirectoryIfMissing True (takeDirectory backup)+          copyFile source backup++withGeneratedHaskellEditionSourceMoves :: [SourceMove] -> Maybe PreparedGeneratedHaskellEditionMigration -> Maybe PreparedGeneratedHaskellEditionMigration+withGeneratedHaskellEditionSourceMoves moves =+  fmap+    ( \prepared ->+        prepared+          { sourceMoves = moves,+            reportText = renderGeneratedHaskellEditionRemediation ((.impact) prepared) moves+          }+    )++renderGeneratedHaskellEditionRemediation :: GeneratedHaskellEditionImpact -> [SourceMove] -> Text+renderGeneratedHaskellEditionRemediation impact sourceMoves =+  T.unlines $+    [ "keiro-dsl generated Haskell edition migration",+      "from: " <> HaskellName.renderGeneratedHaskellNamingEdition ((.fromEdition) impact),+      "to: " <> HaskellName.renderGeneratedHaskellNamingEdition HaskellName.currentGeneratedHaskellNamingEdition,+      "generated-files: " <> tshow (length ((.generatedPaths) impact)),+      "sidecars: " <> tshow (length ((.sidecarPaths) impact)),+      "hand-owned-selector-uses: " <> tshow (length ((.handOwnedUses) impact)),+      "source-moves: " <> tshow (length sourceMoves)+    ]+      <> map renderUse ((.handOwnedUses) impact)+      <> map renderSourceMove sourceMoves+      <> [attributableUsesCaveat]+  where+    renderUse use =+      T.pack ((.path) use)+        <> ":"+        <> tshow ((.line) use)+        <> ": "+        <> (.current) use+        <> " ("+        <> T.pack (show ((.form) use))+        <> ") -> "+        <> (.replacement) use+    renderSourceMove move = T.pack ((.oldPath) move) <> " -> " <> T.pack ((.newPath) move)++attributableUsesCaveat :: Text+attributableUsesCaveat =+  "attributable uses only: unchanged concise labels and files outside the recorded Hole paths are not scanned; compile errors after adoption are the authority"++holeUsesOnLine :: Text -> Text -> Text -> [HoleUseForm]+holeUsesOnLine label target sourceLine+  | "--" `T.isPrefixOf` T.stripStart sourceLine = []+  | otherwise = go sourceLine+  where+    go remaining | T.null remaining = []+    go remaining = case T.breakOn label remaining of+      (_, suffix) | T.null suffix -> []+      (prefix, suffix) ->+        let before = snd <$> T.unsnoc prefix+            after = T.drop (T.length label) suffix+            next = T.dropWhile (== ' ') after+            leftBoundary = maybe True (not . isHaskellIdentifier) before+            rightBoundary = maybe True (not . isHaskellIdentifier) (fst <$> T.uncons after)+            application = maybe False (\character -> character == '(' || isHaskellIdentifier character) (fst <$> T.uncons next)+            qualifier = T.takeWhileEnd isHaskellIdentifier (T.dropEnd 1 prefix)+            qualified = before == Just '.' && maybe False isUpperAscii (fst <$> T.uncons qualifier) && application+            recordDot =+              before == Just '.'+                && maybe False isLowerIdentifier (snd <$> T.unsnoc (T.dropEnd 1 prefix))+                && target /= label+            fieldBinding = unmatchedOpeningBrace prefix && "=" `T.isPrefixOf` next+            operatorOperand = any (`T.isPrefixOf` next) ["<$>", "<&>", "$", ".", "&", "`"]+            prefixApplication = before /= Just '.' && application+            found+              | leftBoundary && rightBoundary && qualified = [QualifiedApplication]+              | leftBoundary && rightBoundary && recordDot = [RecordDotRenamed]+              | leftBoundary && rightBoundary && fieldBinding = [RecordFieldBinding]+              | leftBoundary && rightBoundary && operatorOperand = [OperatorOperand]+              | leftBoundary && rightBoundary && prefixApplication = [PrefixApplication]+              | otherwise = []+         in found <> go (T.drop 1 suffix)+    unmatchedOpeningBrace prefix = T.count "{" prefix > T.count "}" prefix+    isUpperAscii character = character >= 'A' && character <= 'Z'+    isLowerIdentifier character = character == '_' || character >= 'a' && character <= 'z' || character >= '0' && character <= '9'+    isHaskellIdentifier character = character == '_' || character == '\'' || character >= 'A' && character <= 'Z' || character >= 'a' && character <= 'z' || character >= '0' && character <= '9'++-- | Check existing generated paths, then perform the deterministic writes and+-- manifest rewrite. Banner refusal is evaluated for the complete set before the+-- output directory is created or any file is changed.+executeScaffold :: FilePath -> Bool -> FilePath -> Context -> Spec -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeScaffold out forceGeneratedOverwrite specPath ctx spec modules =+  executeScaffoldWithLanguage out forceGeneratedOverwrite specPath LegacyUnversioned ctx spec modules++-- | Source-aware execution used by the CLI; semantic planning still receives only 'Spec'.+executeScaffoldWithLanguage :: FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> Spec -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeScaffoldWithLanguage out forceGeneratedOverwrite specPath sourceLanguage ctx spec modules =+  executeServiceScaffold out forceGeneratedOverwrite specPath sourceLanguage ctx (checkedService sourceLanguage spec) modules++-- | Execute a module plan while retaining both the effective semantic contract+-- and the source declaration provenance written to history. A mismatch refuses+-- before checking or creating any output path.+executeServiceScaffold :: FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeServiceScaffold = executeServiceScaffoldWithRuntimePackage Nothing++executeServiceScaffoldWithRuntimePackage :: Maybe RuntimePackageName -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeServiceScaffoldWithRuntimePackage runtimePackage =+  executeServiceScaffoldWithRuntimePackageAndNameMigrations runtimePackage False++executeServiceScaffoldWithRuntimePackageAndNameMigrations :: Maybe RuntimePackageName -> Bool -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeServiceScaffoldWithRuntimePackageAndNameMigrations runtimePackage applyNameMigrations =+  executeServiceScaffoldWithRuntimePackageAndMigrations runtimePackage applyNameMigrations False++executeServiceScaffoldWithRuntimePackageAndMigrations :: Maybe RuntimePackageName -> Bool -> Bool -> FilePath -> Bool -> FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> IO (Either [Refusal] ScaffoldReport)+executeServiceScaffoldWithRuntimePackageAndMigrations runtimePackage applyNameMigrations applyGeneratedHaskellEdition out forceGeneratedOverwrite specPath sourceLanguage ctx service plannedModules+  | effectiveLanguageContract sourceLanguage /= checkedLanguageContract service =+      pure (Left [SemanticContractMismatch "source provenance and checked service selected different effective language contracts"])+  | otherwise = case packagePlan of+      Left failures -> pure (Left (map ConformancePackageRefusal failures))+      Right plannedPackage -> do+        sidecarResult <- planSidecarMigrations out (ContextSidecars ((.context) spec)) plannedPackage+        case sidecarResult of+          Left reasons -> pure (Left [SidecarMigrationRefusal reasons])+          Right preparedSidecars -> do+            previousBefore <- readMigrationRecord+            editionBefore <- preflightEdition previousBefore+            case editionBefore of+              Left refusals -> pure (Left refusals)+              Right preparedBefore+                | not (null preparedSidecars) && not applyNameMigrations ->+                    pure . Left $+                      [SidecarMigrationRequired (map preparedSidecarMove preparedSidecars)]+                        <> [GeneratedHaskellEditionRequired ((.impact) prepared) | Just prepared <- [preparedBefore]]+                | otherwise -> do+                    applyPreparedSidecarMoves out preparedSidecars+                    let moves = map preparedSidecarMove preparedSidecars+                        -- Past this point the renames are on disk, so a later+                        -- refusal's "nothing was written" needs qualifying.+                        noteApplied = withSidecarMovesApplied moves+                    previousAfter <- if null preparedSidecars then pure previousBefore else readRecord currentRecordPath+                    editionAfter <- preflightEdition previousAfter+                    result <- case editionAfter of+                      Left refusals -> pure (Left refusals)+                      Right preparedEdition -> case plannedPackage of+                        Nothing -> executeCheckedScaffold preparedEdition moves Nothing+                        Just package -> do+                          preparedPackage <- preflightConformancePackage out forceGeneratedOverwrite package+                          case preparedPackage of+                            Left failures -> pure (Left (map ConformancePackageRefusal failures))+                            Right packageReady -> executeCheckedScaffold preparedEdition moves (Just packageReady)+                    pure (either (Left . noteApplied) Right result)+  where+    spec = checkedSpec service+    modules = stampGeneratedModules (checkedLanguageContract service) plannedModules+    currentRecordPath = out </> recordFileName ((.context) spec)+    legacyRecordPath = out </> legacyContextRecordFileName ((.context) spec)+    facadeModule = case runtimePackage of+      Nothing -> Nothing+      Just _ -> Just (serviceConformanceModuleName ctx)+    packagePlan =+      traverse+        (\packageName -> planConformancePackage (StandaloneConformanceService ((.name) ctx)) packageName (serviceConformanceModuleName ctx) service)+        runtimePackage+    readMigrationRecord = do+      current <- readRecord currentRecordPath+      case current of+        LedgerAbsent -> readRecord legacyRecordPath+        _ -> pure current+    preflightEdition previousRead = case ledgerReadRefusals previousRead of+      refusals@(_ : _) -> pure (Left refusals)+      [] -> do+        let previousRecord = ledgerToMaybe previousRead+        prepared <-+          preflightGeneratedHaskellEditionMigration+            out+            ((.namingEdition) <$> previousRecord)+            (maybe [] (.files) previousRecord)+            [contextCabalFragmentFileName ((.context) spec), recordFileName ((.context) spec)]+        pure (either (Left . pure . GeneratedHaskellEditionRefusal) Right prepared)+    executeCheckedScaffold editionMigration sidecarMoves preparedPackage =+      case deriveBehaviorRequirementsForService service of+        Left errors -> pure (Left [BehaviorRefusal errors])+        Right requirements -> do+          bannerless <- if forceGeneratedOverwrite then pure [] else missingGeneratedBanners out modules+          if not (null bannerless)+            then pure (Left [MissingGeneratedBanner bannerless])+            else do+              let recordPath = out </> recordFileName ((.context) spec)+              previousRead <- readRecord recordPath+              let previousRecord = ledgerToMaybe previousRead+              case (ledgerReadRefusals previousRead, planRecordedSourceMoves previousRecord modules) of+                (refusals@(_ : _), _) -> pure (Left refusals)+                (_, Left moveErrors) -> pure (Left [NameMigrationRefusal [T.pack (show moveError) | moveError <- NE.toList moveErrors]])+                (_, Right moves) -> do+                  preparedMoves <- preflightSourceMoves out moves+                  case preparedMoves of+                    Left moveErrors -> pure (Left [NameMigrationRefusal moveErrors])+                    Right prepared+                      | Just edition <- editionWithMoves,+                        (not (null prepared) || not (null sidecarMoves)),+                        not (applyNameMigrations && applyGeneratedHaskellEdition) ->+                          pure (Left [NameMigrationRequired sourceMoves, GeneratedHaskellEditionRequired ((.impact) edition)])+                      | Just edition <- editionWithMoves,+                        not applyGeneratedHaskellEdition ->+                          pure (Left [GeneratedHaskellEditionRequired ((.impact) edition)])+                      | not (null prepared) && not applyNameMigrations ->+                          pure (Left [NameMigrationRequired sourceMoves])+                      | otherwise -> do+                          applyPreparedGeneratedHaskellEditionMigration out editionWithMoves+                          applyPreparedSourceMoves out prepared+                          stale <- maybe (pure []) (existingStale out modules) previousRecord+                          queryMigrations <- queryContractMigrations out modules+                          let currentConsumerPlan = consumerPlanForService service+                              drift = maybe [] (mappingDrift ((.mappings) currentConsumerPlan) . (.mappings)) previousRecord+                              currentQueryContracts = either (const []) id (queryContractIdentitiesForService service)+                              queryHistoryBaseline =+                                not (null currentQueryContracts)+                                  || maybe False (.queryContractBaseline) previousRecord+                              queryBaselineUnavailable =+                                not (null currentQueryContracts)+                                  && maybe False (not . (.queryContractBaseline)) previousRecord+                              queryDrift = case previousRecord of+                                Just previous | (.queryContractBaseline) previous -> queryContractDrift currentQueryContracts ((.queryContracts) previous)+                                _ -> []+                              currentSemanticImpact = checkedSemanticImpactSnapshot service+                              semanticReport = semanticImpactForMappingDrift (previousRecord >>= (.semanticImpact)) currentSemanticImpact drift+                              currentRouterSelections = routerSelectionSnapshots service+                              selectionDrift = maybe [] (\previous -> routerSelectionDrift ((.routerSelections) previous) currentRouterSelections) previousRecord+                              languageDrift = do+                                previous <- previousRecord+                                if (.sourceLanguage) previous == sourceLanguage+                                  then Nothing+                                  else Just (SourceLanguageDrift ((.sourceLanguage) previous) sourceLanguage)+                              currentObligations = either (const []) id (bindingHolesForService service)+                              newHoles = maybe [] (newBindingObligations currentObligations . (.bindingObligations)) previousRecord+                              currentBehavior = behaviorRecordRows requirements+                              (addedBehavior, removedBehavior) = maybe (currentBehavior, []) (behaviorDrift currentBehavior . (.behaviorRequirements)) previousRecord+                          createDirectoryIfMissing True out+                          dispositions <- mapM (writeModule out) modules+                          let manifestPath = out </> contextCabalFragmentFileName ((.context) spec)+                          TIO.writeFile manifestPath (renderManifestForServiceWithFacade facadeModule (T.pack specPath) modules service)+                          TIO.writeFile recordPath (renderRecord (currentRecord specPath sourceLanguage ctx service modules queryHistoryBaseline currentBehavior currentSemanticImpact))+                          packageReport <- traverse executePreparedConformancePackage preparedPackage+                          pure $+                            Right+                              ScaffoldReport+                                { specPath = specPath,+                                  outDir = out,+                                  context = ctx,+                                  dispositions = dispositions,+                                  inertNodes = inertNodesOf spec,+                                  manifestPath = manifestPath,+                                  recordPath = recordPath,+                                  previousSpecPath = (.specPath) <$> previousRecord,+                                  stale = stale,+                                  consumerPlan = currentConsumerPlan,+                                  constraintPlan = constraintPlanForService service currentConsumerPlan,+                                  mappingDrift = drift,+                                  queryContractBaselineUnavailable = queryBaselineUnavailable,+                                  queryContractDrift = queryDrift,+                                  queryContractMigrations = queryMigrations,+                                  semanticImpact = semanticReport,+                                  routerSelectionDrift = selectionDrift,+                                  projectionMappedImpact = projectionMappedImpactForService service,+                                  generatedArtifactImpact = generatedArtifactImpact dispositions,+                                  sourceLanguageDrift = languageDrift,+                                  newHoles = newHoles,+                                  addedBehavior = addedBehavior,+                                  removedBehavior = removedBehavior,+                                  obsoleteOutputHooks = obsoleteGeneratedOutputHooksForService service,+                                  conformancePackage = packageReport,+                                  nameMoves = map preparedSourceMove prepared,+                                  sidecarMoves = sidecarMoves+                                }+                      where+                        sourceMoves = map preparedSourceMove prepared+                        editionWithMoves = withGeneratedHaskellEditionSourceMoves sourceMoves editionMigration++planRecordedSourceMoves :: Maybe ScaffoldRecord -> [ScaffoldModule] -> Either (NE.NonEmpty SourceMoveError) [SourceMove]+planRecordedSourceMoves Nothing _ = Right []+planRecordedSourceMoves (Just previous) current =+  planSourceMoves priorArtifacts current+  where+    priorArtifacts = case (.moduleRoles) previous of+      [] -> [(Nothing, fileKind, path) | (fileKind, path) <- (.files) previous]+      rows -> [(Just ((.role) row), (.kind) row, (.path) row) | row <- rows]++data PreparedSourceMove+  = SourceMoveReady !SourceMove !Text+  | SourceMoveAlreadyApplied !SourceMove++preparedSourceMove :: PreparedSourceMove -> SourceMove+preparedSourceMove = \case+  SourceMoveReady move _ -> move+  SourceMoveAlreadyApplied move -> move++preflightSourceMoves :: FilePath -> [SourceMove] -> IO (Either [Text] [PreparedSourceMove])+preflightSourceMoves out moves = do+  prepared <- mapM preflight moves+  let errors = [message | Left message <- prepared]+  pure $ if null errors then Right [value | Right value <- prepared] else Left errors+  where+    replacements = Map.fromList [((.oldModule) move, (.newModule) move) | move <- moves]+    preflight move = do+      let oldPath = out </> (.oldPath) move+          newPath = out </> (.newPath) move+          backupPath = out </> (.backupPath) move+          preparedPath = preparedSourcePath out move+          statePath = sourceMoveStatePath out move+      oldExists <- doesFileExist oldPath+      newExists <- doesFileExist newPath+      backupExists <- doesFileExist backupPath+      preparedExists <- doesFileExist preparedPath+      stateExists <- doesFileExist statePath+      case (oldExists, backupExists) of+        (True, True) -> conflict move newExists backupExists preparedExists "both legacy source and backup exist"+        (False, False) ->+          if newExists+            then conflict move newExists backupExists preparedExists "target exists without a recoverable legacy source"+            else pure (Left (T.pack ((.oldPath) move) <> ": recorded legacy source is missing"))+        _ -> do+          source <- TIO.readFile (if oldExists then oldPath else backupPath)+          if (.kind) move == Generated && not (any isGeneratedBannerLine (T.lines source))+            then pure (Left (T.pack ((.oldPath) move) <> ": generated source lacks an exact generated banner"))+            else case rewriteHaskellModuleReferences replacements source of+              Left lexicalError -> pure (Left (T.pack ((.oldPath) move) <> ": " <> T.pack (show lexicalError)))+              Right rewritten+                | not (declaresExpectedModule ((.newModule) move) rewritten) ->+                    pure+                      ( Left+                          ( T.pack ((.oldPath) move)+                              <> ": transformed source does not declare expected module "+                              <> (.newModule) move+                          )+                      )+                | otherwise -> do+                    let hydrated =+                          SourceMove+                            { role = move.role,+                              kind = move.kind,+                              oldModule = move.oldModule,+                              newModule = move.newModule,+                              oldPath = move.oldPath,+                              newPath = move.newPath,+                              backupPath = move.backupPath,+                              contentDigest = Just (contentDigest source),+                              transformedDigest = Just (contentDigest rewritten)+                            }+                        expectedState = renderSourceMoveState hydrated+                    stateError <- verifyOptionalText stateExists statePath expectedState "migration state"+                    preparedError <- verifyOptionalDigest preparedExists preparedPath (contentDigest rewritten) "prepared source"+                    targetError <- verifyOptionalDigest newExists newPath (contentDigest rewritten) "target source"+                    case [message | Just message <- [stateError, preparedError, targetError]] of+                      message : _ -> pure (Left (T.pack ((.oldPath) move) <> ": " <> message))+                      []+                        | newExists && not backupExists && not oldExists -> conflict hydrated newExists backupExists preparedExists "target has no recoverable backup"+                        | newExists && backupExists && not oldExists -> pure (Right (SourceMoveAlreadyApplied hydrated))+                        | otherwise -> pure (Right (SourceMoveReady hydrated rewritten))++    conflict move newExists backupExists preparedExists reason =+      pure+        ( Left+            ( T.pack ((.oldPath) move)+                <> ": migration state conflicts ("+                <> reason+                <> "; target="+                <> T.pack (show newExists)+                <> ", backup="+                <> T.pack (show backupExists)+                <> ", prepared="+                <> T.pack (show preparedExists)+                <> ")"+            )+        )++    verifyOptionalText False _ _ _ = pure Nothing+    verifyOptionalText True path expected label = do+      actual <- TIO.readFile path+      pure $ if actual == expected then Nothing else Just (label <> " digest/path evidence does not match")++    verifyOptionalDigest False _ _ _ = pure Nothing+    verifyOptionalDigest True path expected label = do+      actual <- contentDigest <$> TIO.readFile path+      pure $ if actual == expected then Nothing else Just (label <> " digest does not match " <> expected)++    declaresExpectedModule expected source =+      any (T.isPrefixOf ("module " <> expected <> " ")) (T.lines source)+        || any (== ("module " <> expected)) (T.lines source)++applyPreparedSourceMoves :: FilePath -> [PreparedSourceMove] -> IO ()+applyPreparedSourceMoves out prepared = do+  -- Prepare every transformed file and durable digest record before moving a+  -- single active source.  The temporary file lives beside its destination,+  -- so installation is a same-filesystem rename.+  mapM_ prepareMove prepared+  mapM_ backupMove prepared+  mapM_ installMove prepared+  where+    prepareMove preparedMove = do+      let move = preparedSourceMove preparedMove+          statePath = sourceMoveStatePath out move+      createDirectoryIfMissing True (takeDirectory statePath)+      TIO.writeFile statePath (renderSourceMoveState move)+      case preparedMove of+        SourceMoveAlreadyApplied _ -> pure ()+        SourceMoveReady _ rewritten -> do+          let path = preparedSourcePath out move+          createDirectoryIfMissing True (takeDirectory path)+          exists <- doesFileExist path+          if exists then pure () else TIO.writeFile path rewritten++    backupMove (SourceMoveAlreadyApplied _) = pure ()+    backupMove (SourceMoveReady move _) = do+      let oldPath = out </> (.oldPath) move+          backupPath = out </> (.backupPath) move+      oldExists <- doesFileExist oldPath+      if oldExists+        then do+          createDirectoryIfMissing True (takeDirectory backupPath)+          renameFile oldPath backupPath+        else pure ()++    installMove preparedMove = do+      let move = preparedSourceMove preparedMove+          preparedPath = preparedSourcePath out move+          newPath = out </> (.newPath) move+      newExists <- doesFileExist newPath+      preparedExists <- doesFileExist preparedPath+      if newExists+        then if preparedExists then removeFile preparedPath else pure ()+        else do+          createDirectoryIfMissing True (takeDirectory newPath)+          renameFile preparedPath newPath++preparedSourcePath :: FilePath -> SourceMove -> FilePath+preparedSourcePath out move = out </> ((.newPath) move <> ".keiro-dsl-name-migration-prepared")++sourceMoveStatePath :: FilePath -> SourceMove -> FilePath+sourceMoveStatePath out move = out </> ((.backupPath) move <> ".keiro-dsl-name-migration-state")++renderSourceMoveState :: SourceMove -> Text+renderSourceMoveState move =+  T.unlines+    [ "keiro-dsl-name-migration-state v1",+      "old-path " <> T.pack ((.oldPath) move),+      "new-path " <> T.pack ((.newPath) move),+      "old-module " <> (.oldModule) move,+      "new-module " <> (.newModule) move,+      "source-digest " <> maybe "<missing>" id ((.contentDigest) move),+      "transformed-digest " <> maybe "<missing>" id ((.transformedDigest) move)+    ]++constraintPlanForService :: CheckedService -> ConsumerPlan -> [Text]+constraintPlanForService service plan = case checkedTypeGraph service of+  Left _ -> []+  Right graph ->+    let registerRoots =+          Set.fromList+            [ key+            | RootRegister _ _ key <- (.useSites) graph+            ]+     in map (constraintFor registerRoots) ((.mappings) plan)+  where+    constraintFor registerRoots mapping =+      (.specName) mapping+        <> ": "+        <> T.intercalate ", " (baseConstraints mapping <> registerConstraints registerRoots mapping)+    baseConstraints StructuralMapping {} = ["Eq", "Show", "CanonicalTypeName", "StructuralBinding"]+    baseConstraints OpaqueMapping {} = ["Eq", "Show", "ToJSON", "FromJSON"]+    baseConstraints NominalMapping {} = ["Eq", "Show", "NominalBinding"]+    registerConstraints roots mapping+      | MappedKey ((.specName) mapping) `Set.member` roots = ["register initial", "snapshot ToJSON", "snapshot FromJSON"]+      | otherwise = []++mappingDrift :: [MappingIdentity] -> [MappingIdentity] -> [MappingDrift]+mappingDrift current previous =+  [ MappingDrift name old new+  | name <- Set.toAscList (Map.keysSet oldByName <> Map.keysSet newByName),+    let old = Map.lookup name oldByName,+    let new = Map.lookup name newByName,+    old /= new+  ]+  where+    oldByName = Map.fromList [((.specName) mapping, mapping) | mapping <- previous]+    newByName = Map.fromList [((.specName) mapping, mapping) | mapping <- current]++checkedSemanticImpactSnapshot :: CheckedService -> SemanticImpactSnapshot+checkedSemanticImpactSnapshot service = case checkedTypeGraph service of+  Left failures -> error ("validated scaffold type graph did not resolve: " <> show failures)+  Right graph -> semanticImpactSnapshot (semanticImpactForService service graph)++semanticImpactForMappingDrift :: Maybe SemanticImpactSnapshot -> SemanticImpactSnapshot -> [MappingDrift] -> SemanticImpactReport+semanticImpactForMappingDrift previous current drifts =+  semanticImpactReport previous current changedDeclarations+  where+    driftDeclarations = [MappedKey ((.specName) drift) | drift <- drifts]+    snapshotDeclarations = maybe [] (map (.declaration) . (`diffSemanticImpact` current)) previous+    changedDeclarations = driftDeclarations <> snapshotDeclarations++generatedArtifactImpact :: [(ScaffoldModule, WriteDisposition)] -> [GeneratedArtifactImpact]+generatedArtifactImpact dispositions =+  sortOn+    (.path)+    [ GeneratedArtifactImpact+        { category = categoryFor role,+          role = role,+          path = (.path) scaffoldModule,+          disposition = disposition+        }+    | (scaffoldModule, disposition) <- dispositions,+      (.kind) scaffoldModule == Generated,+      disposition `elem` [Overwritten, Created],+      let role = moduleRole scaffoldModule+    ]+  where+    categoryFor role+      | (.family) role == "StructuralConformance" = ServiceStructuralConformanceArtifact+      | (.family) role == "BehaviorSourceMap" = BehaviorSourceMapArtifact+      | (.ownerKind) role == "aggregate"+          || ": aggregate " `T.isInfixOf` (.ownerName) role =+          AggregateGeneratedArtifact+      | otherwise = OtherGeneratedArtifact++newBindingObligations :: [BindingHole] -> [BindingHole] -> [BindingHole]+newBindingObligations current previous =+  [ obligation+  | obligation <- current,+    obligation `Set.notMember` previousSet+  ]+  where+    previousSet = Set.fromList previous++-- | Inspect, but never rewrite, an existing create-once read-model hole. A+-- typed plan is complete only after the application removes its legacy local+-- aliases and imports the generated QueryContract aliases.+queryContractMigrations :: FilePath -> [ScaffoldModule] -> IO [QueryContractMigration]+queryContractMigrations out modules = fmap concat (mapM inspect typedHoles)+  where+    typedHoles =+      [ (hole, requiredImport)+      | hole <- modules,+        (.kind) hole == HoleStub,+        (.family) (moduleRole hole) == "ReadModelHoles",+        requiredImport <- T.lines ((.text) hole),+        "import " `T.isPrefixOf` requiredImport,+        ".QueryContract (" `T.isInfixOf` requiredImport+      ]+    inspect (hole, requiredImport) = do+      let path = out </> (.path) hole+      exists <- doesFileExist path+      if not exists+        then pure []+        else do+          contents <- TIO.readFile path+          let ready = requiredImport `elem` T.lines contents && not (any isLocalQueryAlias (T.lines contents))+          pure+            [ QueryContractMigration+                { owner = queryOwner (moduleRole hole),+                  path = (.path) hole,+                  requiredImport = requiredImport+                }+            | not ready+            ]+    isLocalQueryAlias line = case T.words (T.strip line) of+      "type" : alias : "=" : _ -> "QueryInput" `T.isSuffixOf` alias || "QueryResult" `T.isSuffixOf` alias+      _ -> False+    queryOwner role = case T.words ((.ownerName) role) of+      "readmodel" : owner : _ -> owner+      _ -> (.ownerName) role++behaviorDrift :: [BehaviorRecordRow] -> [BehaviorRecordRow] -> ([BehaviorRecordRow], [BehaviorRecordRow])+behaviorDrift current previous =+  ( [row | row <- sortOn (.key) current, (.key) row `Set.notMember` previousKeys],+    [row | row <- sortOn (.key) previous, (.key) row `Set.notMember` currentKeys]+  )+  where+    currentKeys = Set.fromList (map (.key) current)+    previousKeys = Set.fromList (map (.key) previous)++readRecord :: FilePath -> IO (LedgerRead ScaffoldRecord)+readRecord path = do+  exists <- doesFileExist path+  if not exists+    then pure LedgerAbsent+    else do+      parsed <- parseRecord <$> TIO.readFile path+      pure (maybe (LedgerReadUnreadable path) LedgerParsed parsed)++ledgerToMaybe :: LedgerRead a -> Maybe a+ledgerToMaybe LedgerAbsent = Nothing+ledgerToMaybe (LedgerParsed value) = Just value+ledgerToMaybe (LedgerReadUnreadable _) = Nothing++ledgerReadRefusals :: LedgerRead a -> [Refusal]+ledgerReadRefusals (LedgerReadUnreadable path) = [LedgerUnreadable path]+ledgerReadRefusals _ = []++existingStale :: FilePath -> [ScaffoldModule] -> ScaffoldRecord -> IO [StaleModule]+existingStale out modules record = staleAgainst out (map (.path) modules) ((.files) record)++-- | The files a previous run recorded that the current plan no longer produces+-- and that are still on disk. keiro-dsl never deletes; this is what the report+-- lists for a human to review.+staleAgainst :: FilePath -> [FilePath] -> [(ModuleKind, FilePath)] -> IO [StaleModule]+staleAgainst out currentPathList previous = fmap concat $ mapM stillExists removed+  where+    currentPaths = Set.fromList currentPathList+    removed = [(fileKind, path) | (fileKind, path) <- previous, path `Set.notMember` currentPaths]+    stillExists (fileKind, path) = do+      let fullPath = out </> path+      exists <- doesFileExist fullPath+      if not exists+        then pure []+        else do+          evidence <- case fileKind of+            HoleStub -> pure Nothing+            Generated -> do+              contents <- TIO.readFile fullPath+              pure . Just $+                if any isGeneratedBannerLine (T.lines contents)+                  then ExactGeneratedBannerPresent+                  else ExactGeneratedBannerMissing+          pure [StaleModule fileKind path evidence]++currentRecord :: FilePath -> SourceLanguage -> Context -> CheckedService -> [ScaffoldModule] -> Bool -> [BehaviorRecordRow] -> SemanticImpactSnapshot -> ScaffoldRecord+currentRecord specPath sourceLanguage ctx service modules queryHistoryBaseline currentBehavior currentSemanticImpact =+  ScaffoldRecord+    { specPath = T.pack specPath,+      moduleRoot = (.moduleRoot) ctx,+      layout = case (.placement) ctx of GeneratedPrefix -> "prefixed"; CollocatedLeaf -> "collocated",+      sourceLanguage = sourceLanguage,+      languageContract = checkedLanguageContract service,+      namingEdition = currentGeneratedHaskellNamingEdition,+      moduleRoles = [ScaffoldModuleRoleRow (moduleRole m) ((.kind) m) ((.path) m) | m <- modules],+      files = [((.kind) m, (.path) m) | m <- modules],+      mappings = (.mappings) (consumerPlanForService service),+      idDomains = idDomainIdentitiesForService service,+      nominalEqualities = nominalEqualityIdentitiesForService service,+      bindingObligations = either (const []) id (bindingHolesForService service),+      behaviorRequirements = currentBehavior,+      projectionCatalogFacts = projectionCatalogFactsForService service,+      queryContractBaseline = queryHistoryBaseline,+      queryContracts = either (const []) id (queryContractIdentitiesForService service),+      routerSelections = routerSelectionSnapshots service,+      semanticImpact = Just currentSemanticImpact+    }++missingGeneratedBanners :: FilePath -> [ScaffoldModule] -> IO [FilePath]+missingGeneratedBanners out modules = fmap concat $ mapM check generated+  where+    generated = [m | m <- modules, (.kind) m == Generated]+    check m = do+      let path = out </> (.path) m+      exists <- doesFileExist path+      if not exists+        then pure []+        else do+          contents <- TIO.readFile path+          pure [(.path) m | not (any isGeneratedBannerLine (T.lines contents))]++writeModule :: FilePath -> ScaffoldModule -> IO (ScaffoldModule, WriteDisposition)+writeModule out m = do+  let path = out </> (.path) m+  createDirectoryIfMissing True (takeDirectory path)+  case (.kind) m of+    Generated -> do+      exists <- doesFileExist path+      if exists+        then do+          existing <- TIO.readFile path+          if existing == (.text) m+            then pure (m, Unchanged)+            else TIO.writeFile path ((.text) m) >> pure (m, Overwritten)+        else TIO.writeFile path ((.text) m) >> pure (m, Overwritten)+    HoleStub -> do+      exists <- doesFileExist path+      if exists+        then pure (m, Skipped)+        else TIO.writeFile path ((.text) m) >> pure (m, Created)++-- | Qualify a refusal set raised after the run's sidecar renames were applied.+--+-- Every refusal message says "nothing was written", which is true of the module+-- tree but not of the renames, so the note is appended rather than the claim+-- being weakened everywhere. A refusal set that is empty stays empty.+withSidecarMovesApplied :: [SidecarMove] -> [Refusal] -> [Refusal]+withSidecarMovesApplied [] refusals = refusals+withSidecarMovesApplied _ [] = []+withSidecarMovesApplied moves refusals = refusals <> [SidecarMovesAlreadyApplied moves]++renderRefusals :: [Refusal] -> [Text]+renderRefusals allRefusals =+  concatMap render allRefusals+    <> [ "this tree needs both --apply-name-migrations and --apply-generated-haskell-edition in one run"+       | any requiresNameMigration allRefusals,+         any requiresEditionMigration allRefusals+       ]+  where+    requiresNameMigration = \case+      NameMigrationRequired _ -> True+      SidecarMigrationRequired _ -> True+      _ -> False+    requiresEditionMigration = \case+      GeneratedHaskellEditionRequired _ -> True+      _ -> False+    render (PathCollision path origins) =+      [ "error: module path collision -- refusing to scaffold; nothing was written",+        "  " <> T.pack path+      ]+        <> ["    from " <> source | source <- origins]+    render (FirewallBreach breaches) =+      [ "error: firewall breach -- refusing to scaffold; nothing was written",+        "firewall: BREACH (" <> tshow (length breaches) <> " forbidden token occurrence(s)):"+      ]+        <> ["  " <> T.pack path <> ":" <> tshow line <> " contains " <> token | (path, token, line) <- breaches]+    render (LoweringRefusal refusals) =+      ["error: scaffold cannot lower this spec faithfully -- refusing; nothing was written"]+        <> map ("  " <>) refusals+    render (MissingGeneratedBanner paths) =+      [ "error: refusing to overwrite " <> tshow (length paths) <> " file(s) at Generated paths that lack the '-- @generated' banner"+      ]+        <> map ("  " <>) (map T.pack paths)+        <> ["  (adopted as hand code? move it, or re-run with --force-generated-overwrite)", "nothing was written"]+    render (ImportCycle path) =+      [ "error: generated/consumer import cycle -- refusing to scaffold; nothing was written",+        "  " <> T.intercalate " -> " path,+        "  keep bindings in a leaf module that imports only Structural.Shape.* and Keiro.Codec.Structural"+      ]+    render (BehaviorRefusal errors) =+      ["error: behavior obligations cannot be derived soundly -- refusing to scaffold; nothing was written"]+        <> ["  " <> T.pack (show behaviorError) | behaviorError <- errors]+    render (BehaviorSourceRefusal failures) =+      ["error: behavior source map cannot be planned -- refusing to scaffold; nothing was written"]+        <> [ "  "+               <> T.pack (show ((.code) failure))+               <> " "+               <> Behavior.unBehaviorKey ((.key) failure)+               <> ": "+               <> (.message) failure+           | failure <- failures+           ]+    render (GeneratedNameInvariantViolation violations) =+      ["error: generated Haskell name invariant violated -- refusing to scaffold; nothing was written"]+        <> map ("  " <>) violations+    render (NameMigrationRequired moves) =+      [ "error: name migration required: legacy-v1 -> idiomatic-v1; nothing was written",+        "re-run scaffold with --apply-name-migrations after reviewing these source moves:"+      ]+        <> map renderMove moves+    render (NameMigrationRefusal reasons) =+      ["error: name migration could not be applied safely; nothing was written"]+        <> map ("  " <>) reasons+    render (SidecarMigrationRequired moves) =+      [ "error: sidecar migration required; nothing was written",+        "re-run scaffold with --apply-name-migrations after reviewing these sidecar renames:"+      ]+        <> map (("  " <>) . renderSidecarMove) moves+    render (SidecarMigrationRefusal reasons) =+      ["error: sidecar migration could not be applied safely; nothing was written"]+        <> map ("  " <>) reasons+    render (GeneratedHaskellEditionRequired impact) =+      [ "error: generated Haskell edition migration required: "+          <> HaskellName.renderGeneratedHaskellNamingEdition ((.fromEdition) impact)+          <> " -> "+          <> HaskellName.renderGeneratedHaskellNamingEdition HaskellName.currentGeneratedHaskellNamingEdition+          <> "; nothing was written",+        "re-run scaffold with --apply-generated-haskell-edition after reviewing this impact:",+        "  generated files: " <> tshow (length ((.generatedPaths) impact))+      ]+        <> map (("    " <>) . T.pack) ((.generatedPaths) impact)+        <> ["  sidecars: " <> tshow (length ((.sidecarPaths) impact))]+        <> map (("    " <>) . T.pack) ((.sidecarPaths) impact)+        <> ["  hand-owned selector uses: " <> tshow (length ((.handOwnedUses) impact))]+        <> map renderEditionUse ((.handOwnedUses) impact)+        <> ["  " <> attributableUsesCaveat]+    render (GeneratedHaskellEditionRefusal reasons) =+      ["error: generated Haskell edition migration could not be applied safely; nothing was written"]+        <> map ("  " <>) reasons+    render (LedgerUnreadable path) =+      [ "error: scaffold ledger " <> T.pack path <> " exists but could not be parsed; nothing was written",+        "  restore it from version control or from the edition backup before scaffolding again"+      ]+    render (SidecarMovesAlreadyApplied moves) =+      [ "note: this run had already applied "+          <> tshow (length moves)+          <> " sidecar rename(s) before the refusal above, so \"nothing was written\" excludes them:"+      ]+        <> map (("  " <>) . renderSidecarMove) moves+        <> [ "The renames are idempotent and carry no spec content, so re-running scaffold",+             "after fixing the refusal is correct; nothing needs to be undone."+           ]+    render (FoldSurfaceRefusal surfaceError) =+      [ "error: aggregate fold identity could not be resolved -- refusing to scaffold; nothing was written",+        "  " <> renderFoldSurfaceError surfaceError+      ]+    render (SemanticContractMismatch detail) =+      [ "error: semantic language contract mismatch -- refusing to scaffold; nothing was written",+        "  " <> detail+      ]+    render (GoldenRootDivergence root paths) =+      [ "error: golden payload fixtures live beside a workspace member instead of under the workspace golden root -- refusing to scaffold"+      ]+        <> ["  " <> T.pack path | path <- paths]+        <> [ "  move these files under " <> T.pack root <> "; keiro-dsl reads one golden root per workspace",+             "  (a fixture the root lacks would be silently replaced by a synthesized stand-in)",+             "nothing was written"+           ]+    render (DuplicateConformanceFactKeys duplicates) =+      ["error: duplicate normalized service conformance fact keys -- refusing to scaffold; nothing was written"]+        <> ["  " <> (.duplicateServiceFactKey) duplicate | duplicate <- duplicates]+    render (ConformancePackageRefusal failure) = renderConformancePackageFailure failure+    renderMove move =+      "  "+        <> (case (.kind) move of Generated -> "generated "; HoleStub -> "hole      ")+        <> (.oldModule) move+        <> " -> "+        <> (.newModule) move+        <> "  backup: "+        <> T.pack ((.backupPath) move)+    renderEditionUse use =+      "    "+        <> T.pack ((.path) use)+        <> ":"+        <> tshow ((.line) use)+        <> ": "+        <> (.current) use+        <> " ("+        <> T.pack (show ((.form) use))+        <> ")"+        <> " -> "+        <> (.replacement) use++renderSemanticImpactReport :: SemanticImpactReport -> [Text]+renderSemanticImpactReport report = case (.declarations) report of+  [] -> []+  declarations ->+    ["semantic impact:"]+      <> case (.previous) report of+        Nothing ->+          ["  baseline: unavailable (legacy ledger)"]+            <> concatMap renderCurrent declarations+        Just _ -> concatMap renderDelta ((.deltas) report)+  where+    renderCurrent declaration =+      [ "  " <> (.unMappedKey) declaration,+        "    current aggregate consumers: " <> renderConsumers (Map.findWithDefault Set.empty declaration ((.mappedConsumers) ((.current) report))),+        "    current roots: " <> maybe "baseline unavailable" (renderEvidence . Map.findWithDefault Set.empty declaration) ((.mappedEvidence) ((.current) report)),+        "    current consequences: " <> maybe "baseline unavailable" (renderConsequences . Map.findWithDefault Set.empty declaration) ((.mappedConsequences) ((.current) report)),+        "    service-conformance: impacted"+      ]+    renderDelta delta =+      [ "  " <> (.unMappedKey) ((.declaration) delta),+        "    previous aggregate consumers: " <> renderConsumers ((.previousConsumers) delta),+        "    current aggregate consumers:  " <> renderConsumers ((.currentConsumers) delta),+        "    previous roots: " <> maybe "baseline unavailable" renderEvidence ((.previousEvidence) delta),+        "    current roots:  " <> maybe "baseline unavailable" renderEvidence ((.currentEvidence) delta),+        "    previous consequences: " <> maybe "baseline unavailable" renderConsequences ((.previousConsequences) delta),+        "    current consequences:  " <> maybe "baseline unavailable" renderConsequences ((.currentConsequences) delta),+        "    service-conformance: " <> if (.serviceConformance) delta then "impacted" else "unchanged"+      ]+    renderConsumers aggregateConsumers = case map consumerName (Set.toAscList aggregateConsumers) of+      [] -> "(none)"+      names -> T.intercalate ", " names+    consumerName = mappedConsumerIdentity+    renderEvidence = renderSet renderRoot+    renderRoot evidence =+      T.intercalate "|" [mappedRootKindIdentity ((.rootKind) evidence), mappedConsumerIdentity ((.consumer) evidence), (.path) evidence]+        <> maybe "" ("|" <>) ((.operation) evidence)+    renderConsequences = renderSet mappedConsequenceIdentity+    renderSet render values = case map render (Set.toAscList values) of+      [] -> "(none)"+      rendered -> T.intercalate ", " rendered++renderGeneratedArtifactImpact :: SemanticImpactReport -> [GeneratedArtifactImpact] -> [Text]+renderGeneratedArtifactImpact _ [] = []+renderGeneratedArtifactImpact semanticReport impacts =+  "generated-artifact impact:" : map renderArtifact impacts+  where+    renderArtifact impact =+      "  "+        <> categoryLabel ((.category) impact)+        <> " "+        <> T.pack ((.path) impact)+        <> " ("+        <> dispositionLabel ((.disposition) impact)+        <> ")"+    categoryLabel AggregateGeneratedArtifact+      | null ((.deltas) semanticReport) = "aggregate (generator or non-mapped drift; no mapped semantic impact)"+      | otherwise = "aggregate"+    categoryLabel ServiceStructuralConformanceArtifact = "service-conformance"+    categoryLabel BehaviorSourceMapArtifact = "behavior-source-map"+    categoryLabel OtherGeneratedArtifact = "generated"+    dispositionLabel Overwritten = "overwritten"+    dispositionLabel Created = "created"+    dispositionLabel Skipped = "skipped"+    dispositionLabel Unchanged = "unchanged"++renderScaffoldReport :: ScaffoldReport -> [Text]+renderScaffoldReport report =+  [ "scaffold: " <> T.pack ((.specPath) report) <> " -> " <> T.pack ((.outDir) report) <> " (module-root=" <> rootLabel <> ", layout=" <> layoutLabel <> ")"+  ]+    <> map moduleLine dispositions+    <> inertNodeSection+    <> [ "firewall: OK (" <> tshow generatedCount <> " generated modules scanned, 0 forbidden operators)",+         harnessLine,+         dependencyLine,+         "fragment: " <> T.pack ((.manifestPath) report),+         "ledger:   " <> T.pack ((.recordPath) report)+       ]+    <> previousSpecNote+    <> constraintSection+    <> newHolesSection+    <> queryContractSection+    <> queryContractMigrationSection+    <> mappingDriftSection+    <> renderSemanticImpactReport ((.semanticImpact) report)+    <> renderRouterSelectionDrift ((.routerSelectionDrift) report)+    <> maybe [] renderProjectionMappedImpact ((.projectionMappedImpact) report)+    <> renderGeneratedArtifactImpact ((.semanticImpact) report) ((.generatedArtifactImpact) report)+    <> sourceLanguageDriftSection+    <> behaviorDriftSection+    <> obsoleteOutputSection+    <> sidecarMoveSection+    <> nameMoveSection+    <> staleSection+    <> maybe [] renderConformancePackageReport ((.conformancePackage) report)+  where+    ctx = (.context) report+    dispositions = (.dispositions) report+    rootLabel = if T.null ((.moduleRoot) ctx) then "(none)" else (.moduleRoot) ctx+    layoutLabel = case (.placement) ctx of GeneratedPrefix -> "prefixed"; CollocatedLeaf -> "collocated"+    names = [moduleNameOf ((.path) m) | (m, _) <- dispositions]+    nameWidth = maximum (1 : map T.length names)+    moduleLine (m, disposition) =+      "  " <> kindTag ((.kind) m) <> "  " <> pad (moduleNameOf ((.path) m)) <> "  " <> dispositionTag disposition+    kindTag Generated = "generated"+    kindTag HoleStub = "hole     "+    dispositionTag Overwritten = "(overwritten)"+    dispositionTag Created = "(created)"+    dispositionTag Skipped = "(skipped: already present)"+    dispositionTag Unchanged = "(unchanged)"+    pad name = name <> T.replicate (nameWidth - T.length name) " "+    generatedCount = length [() | (m, _) <- dispositions, (.kind) m == Generated]+    inertNodeSection = renderInertNodeSection ((.inertNodes) report)+    harnesses =+      sortOn+        id+        [ moduleNameOf ((.path) m)+        | (m, _) <- dispositions,+          any (`T.isSuffixOf` moduleNameOf ((.path) m)) [".Harness", ".ProcessHarness", ".WorkflowFacts"]+        ]+    harnessLine = case harnesses of+      [] -> "harness:  (none emitted)"+      _ -> "harness:  run `cabal test <your-component>` over " <> T.unwords harnesses+    dependencyLine =+      "dependency plan: consumer packages "+        <> renderBracketed ((.packages) ((.consumerPlan) report))+        <> ", consumer modules "+        <> renderBracketed ((.modules) ((.consumerPlan) report))+    constraintSection = case (.constraintPlan) report of+      [] -> []+      constraints -> "constraint plan:" : map ("  " <>) constraints+    newHolesSection = case (.newHoles) report of+      [] -> []+      obligations ->+        ["newly required holes since last scaffold: " <> tshow (length obligations)]+          <> concatMap obligationLines obligations+    obligationLines hole =+      [ "  " <> (.moduleName) hole,+        "    " <> (.signature) hole <> " (" <> obligationKindLabel ((.kind) hole) <> ")"+      ]+    queryContractSection =+      [ "query contract history: baseline unavailable in the previous ledger; no legacy `()` API was inferred"+      | (.queryContractBaselineUnavailable) report+      ]+        <> case (.queryContractDrift) report of+          [] -> []+          drifts ->+            ["query contract drift: " <> tshow (length drifts) <> " input/result position(s) changed since the previous scaffold:"]+              <> concatMap queryDriftLines drifts+    queryDriftLines drift =+      [ "  " <> readModel <> " " <> queryPositionLabel position,+        "    previous: " <> maybe "(absent)" renderQueryIdentity ((.previous) drift),+        "    current:  " <> maybe "(absent)" renderQueryIdentity ((.current) drift)+      ]+      where+        (readModel, position) = (.key) drift+    renderQueryIdentity identity =+      (.typeExpression) identity+        <> " mapped=["+        <> T.intercalate ", " ((.mappedDependencies) identity)+        <> "]"+    queryPositionLabel QueryInputConsumer = "input"+    queryPositionLabel QueryResultConsumer = "result"+    queryContractMigrationSection = case (.queryContractMigrations) report of+      [] -> []+      migrations ->+        ["query contract migration required: " <> tshow (length migrations) <> " hand-owned hole module(s)"]+          <> concatMap migrationLines migrations+    migrationLines migration =+      [ "  " <> (.owner) migration,+        "    edit " <> T.pack ((.path) migration),+        "    remove the local QueryInput/QueryResult type aliases",+        "    add " <> (.requiredImport) migration+      ]+    previousSpecNote = case (.previousSpecPath) report of+      Just previous+        | previous /= T.pack ((.specPath) report) ->+            [ "note: the previous scaffold record used spec " <> previous,+              "      specs sharing context " <> (.name) ctx <> " in one --out also share " <> T.pack ((.manifestPath) report)+            ]+      _ -> []+    mappingDriftSection = case (.mappingDrift) report of+      [] -> []+      drifts ->+        ["mapping drift: " <> tshow (length drifts) <> " declaration(s) changed since the previous scaffold:"]+          <> concatMap driftLines drifts+    driftLines drift =+      [ "  " <> (.specName) drift,+        "    previous: " <> maybe "(absent)" renderMappingIdentity ((.previous) drift),+        "    current:  " <> maybe "(absent)" renderMappingIdentity ((.current) drift)+      ]+    sourceLanguageDriftSection = case (.sourceLanguageDrift) report of+      Nothing -> []+      Just drift ->+        [ "source-language drift: "+            <> sourceLanguageLabel ((.previous) drift)+            <> " -> "+            <> sourceLanguageLabel ((.current) drift)+            <> " (generated module bytes are semantic and unaffected)"+        ]+    behaviorDriftSection =+      renderBehaviorRows "new behavior obligations" ((.addedBehavior) report)+        <> renderBehaviorRows "removed behavior obligations (consumer rows become stale)" ((.removedBehavior) report)+    renderBehaviorRows _ [] = []+    renderBehaviorRows label rows =+      [label <> ": " <> tshow (length rows)] <> concatMap behaviorLines rows+    behaviorLines row =+      [ "  "+          <> (.aggregate) row+          <> ":"+          <> (.source) row+          <> " -- "+          <> (.command) row+          <> "  "+          <> (.unBehaviorKey) ((.key) row),+        "    Pending (BehaviorKey " <> tshow ((.unBehaviorKey) ((.key) row)) <> ")"+      ]+    obsoleteOutputSection = case (.obsoleteOutputHooks) report of+      [] -> []+      hooks ->+        ["obsolete identity-copy output hooks (if still present, they are unused and may be removed):"]+          <> ["  " <> aggregate <> ".Holes." <> hook | (aggregate, hook) <- hooks]+    sidecarMoveSection = case (.sidecarMoves) report of+      [] -> []+      moves ->+        ["sidecar migration: applied (" <> tshow (length moves) <> " move(s))"]+          <> map (("  " <>) . renderSidecarMove) moves+    nameMoveSection = case (.nameMoves) report of+      [] -> []+      moves ->+        ["name migration: applied (" <> tshow (length moves) <> " source move(s))"]+          <> ["  backup: " <> T.pack ((.backupPath) move) | move <- moves]+    staleSection = case (.stale) report of+      [] -> []+      stale ->+        [ "stale: " <> tshow (length stale) <> " file(s) from a previous scaffold of context " <> (.name) ctx <> " are no longer produced by this spec:"+        ]+          <> map staleLine stale+          <> ["note: keiro-dsl never deletes files."]+    staleLine stale = case ((.kind) stale, (.generatedEvidence) stale) of+      (Generated, Just ExactGeneratedBannerPresent) ->+        "  generated " <> T.pack ((.path) stale) <> "  (exact generated banner present; verify unchanged bytes before deleting)"+      (Generated, _) ->+        "  generated " <> T.pack ((.path) stale) <> "  (exact generated banner missing; preserve and review)"+      (HoleStub, _) -> "  hole      " <> T.pack ((.path) stale) <> "  (hand-owned — preserve and review)"++sourceLanguageLabel :: SourceLanguage -> Text+sourceLanguageLabel sourceLanguage =+  sourceFormText sourceLanguage+    <> "/effective-v"+    <> languageVersionText (effectiveLanguageVersion sourceLanguage)++obligationKindLabel :: BindingObligationKind -> Text+obligationKindLabel BindingValue = "binding"+obligationKindLabel FixtureValue = "fixtures"+obligationKindLabel InitialValue = "initial-value"++renderBracketed :: [Text] -> Text+renderBracketed values = "[" <> T.intercalate ", " values <> "]"++renderMappingIdentity :: MappingIdentity -> Text+renderMappingIdentity StructuralMapping {package, moduleName, valueType, bindingSymbol, bindingVersion} =+  "structural "+    <> package+    <> ":"+    <> moduleName+    <> "."+    <> valueType+    <> " binding="+    <> bindingSymbol+    <> " version="+    <> bindingVersion+renderMappingIdentity OpaqueMapping {package, moduleName, valueType, codecIdentity, codecVersion} =+  "opaque "+    <> package+    <> ":"+    <> moduleName+    <> "."+    <> valueType+    <> " codec="+    <> codecIdentity+    <> " version="+    <> codecVersion+renderMappingIdentity NominalMapping {nominalCategory, nominalRepresentation, package, moduleName, valueType, bindingSymbol, bindingVersion} =+  "nominal-"+    <> nominalCategory+    <> " "+    <> package+    <> ":"+    <> moduleName+    <> "."+    <> valueType+    <> " representation="+    <> nominalRepresentation+    <> " binding="+    <> bindingSymbol+    <> " version="+    <> bindingVersion  tshow :: (Show a) => a -> Text tshow = T.pack . show

src/Keiro/Dsl/SemanticContract.hs view

@@ -6,9 +6,7 @@ -- normalized service-level input used after parsing and workspace composition. -- It deliberately wraps 'Spec' rather than becoming part of the graph. module Keiro.Dsl.SemanticContract-  ( EffectiveLanguageContract,-    effectiveContractLanguageVersion,-    effectiveRuntimeProfile,+  ( EffectiveLanguageContract (..),     effectiveRuntimeSemantics,     effectiveLanguageSupport,     languageContractNotice,@@ -35,13 +33,13 @@ import Data.Text qualified as T import Keiro.Dsl.Grammar (Spec) import Keiro.Dsl.LanguageVersion-  ( LanguageSupport (..),+  ( LanguageDefinition (..),+    LanguageSupport (..),     LanguageVersion,     ParsedSource (..),     RuntimeSemanticsProfile,     SourceLanguage (..),     currentStableLanguageVersion,-    definitionRuntimeSemanticsProfile,     effectiveLanguageVersion,     languageSupportForVersion,     languageSupportText,@@ -62,22 +60,22 @@ -- fold, replay, diff, and generation planners consume that discriminator rather -- than re-deriving policy from source text. data EffectiveLanguageContract = EffectiveLanguageContract-  { effectiveContractLanguageVersion :: !LanguageVersion,-    effectiveRuntimeProfile :: !RuntimeSemanticsProfile+  { contractLanguageVersion :: !LanguageVersion,+    runtimeProfile :: !RuntimeSemanticsProfile   }   deriving stock (Eq, Ord, Show)  -- | Stable compatibility projection for records, JSON, and diagnostics. -- Runtime behavior queries 'effectiveRuntimeProfile' capabilities instead. effectiveRuntimeSemantics :: EffectiveLanguageContract -> Text-effectiveRuntimeSemantics = runtimeProfileIdentifier . effectiveRuntimeProfile+effectiveRuntimeSemantics = runtimeProfileIdentifier . (.runtimeProfile)  -- | Lifecycle classification derived from the authoritative language registry. effectiveLanguageSupport :: EffectiveLanguageContract -> LanguageSupport effectiveLanguageSupport contract =   fromMaybe     (error "keiro-dsl internal invariant: effective contract selected an unregistered language version")-    (languageSupportForVersion (effectiveContractLanguageVersion contract))+    (languageSupportForVersion ((.contractLanguageVersion) contract))  -- | One stderr line naming a compatibility-only effective contract. Published -- stable and active candidate sources stay silent.@@ -88,7 +86,7 @@       Just         ( T.pack subject             <> ": language contract: effective keiro-dsl "-            <> languageVersionText (effectiveContractLanguageVersion contract)+            <> languageVersionText ((.contractLanguageVersion) contract)             <> " ("             <> sourceFormSummary             <> ", "@@ -105,7 +103,7 @@ instance ToJSON EffectiveLanguageContract where   toJSON contract =     object-      [ "languageVersion" .= languageVersionNumber (effectiveContractLanguageVersion contract),+      [ "languageVersion" .= languageVersionNumber ((.contractLanguageVersion) contract),         "runtimeSemantics" .= effectiveRuntimeSemantics contract,         "languageSupport" .= languageSupportText (effectiveLanguageSupport contract)       ]@@ -145,42 +143,42 @@   definition <- lookupLanguageDefinition version   pure     EffectiveLanguageContract-      { effectiveContractLanguageVersion = version,-        effectiveRuntimeProfile = definitionRuntimeSemanticsProfile definition+      { contractLanguageVersion = version,+        runtimeProfile = (.runtimeSemanticsProfile) definition       }  -- | Deduplicated, stable replay-fold segments explicitly declared by the -- effective runtime capabilities. Grammar-, validation-, and codec-only -- changes deliberately contribute no segment. runtimeSemanticsFingerprintSegments :: EffectiveLanguageContract -> [Text]-runtimeSemanticsFingerprintSegments = runtimeProfileFoldSegments . effectiveRuntimeProfile+runtimeSemanticsFingerprintSegments = runtimeProfileFoldSegments . (.runtimeProfile)  -- | A normalized service graph paired with the effective contract under which -- it was checked. Member-level declared/legacy provenance intentionally stays -- on 'ParsedSource' or 'Keiro.Dsl.Workspace.WorkspaceMember'. data CheckedService = CheckedService-  { serviceLanguageContract :: !EffectiveLanguageContract,-    serviceSpec :: !Spec,-    serviceTypeGraph :: Either (NonEmpty TypeGraphError) TypeGraph,-    serviceProjectionSupplies :: ProjectionSupplyAnalysis+  { languageContract :: !EffectiveLanguageContract,+    spec :: !Spec,+    typeGraph :: Either (NonEmpty TypeGraphError) TypeGraph,+    projectionSupplies :: ProjectionSupplyAnalysis   }  checkedLanguageContract :: CheckedService -> EffectiveLanguageContract-checkedLanguageContract = serviceLanguageContract+checkedLanguageContract = (.languageContract)  checkedSpec :: CheckedService -> Spec-checkedSpec = serviceSpec+checkedSpec = (.spec)  -- | Shared, lazily forced resolution of 'checkedSpec'. This derived value is -- never serialized and is deliberately excluded from Eq and Show. checkedTypeGraph :: CheckedService -> Either (NonEmpty TypeGraphError) TypeGraph-checkedTypeGraph = serviceTypeGraph+checkedTypeGraph = (.typeGraph)  -- | Shared, lazily forced projection-supply analysis of 'checkedSpec'. This -- derived value is never serialized and is deliberately excluded from Eq and -- Show. checkedProjectionSupplies :: CheckedService -> ProjectionSupplyAnalysis-checkedProjectionSupplies = serviceProjectionSupplies+checkedProjectionSupplies = (.projectionSupplies)  -- | Replace a service's spec while preserving its effective language contract -- and rebuilding the lazy whole-spec analysis cache for the replacement.@@ -205,7 +203,7 @@ -- selected contract. checkedSource :: ParsedSource -> CheckedService checkedSource parsed =-  checkedService (parsedSourceLanguage parsed) (parsedSpec parsed)+  checkedService ((.sourceLanguage) parsed) ((.spec) parsed)  -- | Construct a service from a source-language selection and normalized graph. -- Workspace composition uses this only after proving that every member has the@@ -219,10 +217,10 @@ checkedServiceForContract :: EffectiveLanguageContract -> Spec -> CheckedService checkedServiceForContract languageContract spec =   CheckedService-    { serviceLanguageContract = languageContract,-      serviceSpec = spec,-      serviceTypeGraph = resolveTypeGraph spec,-      serviceProjectionSupplies = analyzeProjectionSupplies spec+    { languageContract = languageContract,+      spec = spec,+      typeGraph = resolveTypeGraph spec,+      projectionSupplies = analyzeProjectionSupplies spec     }  -- | Compatibility bridge for callers that historically supplied only 'Spec'.

src/Keiro/Dsl/SemanticImpact.hs view

@@ -97,10 +97,10 @@  -- | One checked aggregate root before transitive declaration expansion. data MappedRoot = MappedRoot-  { mappedRootConsumer :: !MappedConsumer,-    mappedRootKind :: !MappedRootKind,-    mappedRootUseSite :: !UseSite,-    mappedRootDeclaration :: !MappedKey+  { consumer :: !MappedConsumer,+    kind :: !MappedRootKind,+    useSite :: !UseSite,+    declaration :: !MappedKey   }   deriving stock (Eq, Ord, Show, Generic) @@ -108,10 +108,10 @@ -- one declaration. Unlike 'MappedRoot', this also represents transitive paths -- and therefore is suitable for durable ledgers and exact conformance facts. data MappedRootEvidence = MappedRootEvidence-  { evidenceConsumer :: !MappedConsumer,-    evidenceRootKind :: !MappedRootKind,-    evidencePath :: !Text,-    evidenceOperation :: !(Maybe Text)+  { consumer :: !MappedConsumer,+    rootKind :: !MappedRootKind,+    path :: !Text,+    operation :: !(Maybe Text)   }   deriving stock (Eq, Ord, Show, Generic) @@ -138,15 +138,15 @@ -- intentionally unused declaration to the empty set. The service inventory is -- declaration ownership for conformance; it is not another aggregate consumer. data SemanticImpact = SemanticImpact-  { impactRoots :: ![MappedRoot],-    impactUsePaths :: !(Map MappedKey [UsePath]),-    impactAggregateDeclarations :: !(Map MappedConsumer (Set MappedKey)),-    impactDeclarationConsumers :: !(Map MappedKey (Set MappedConsumer)),-    impactDeclarationEvidence :: !(Map MappedKey (Set MappedRootEvidence)),-    impactDeclarationConsequences :: !(Map MappedKey (Set MappedConsequence)),-    impactServiceDeclarations :: !(Set MappedKey),-    impactDeclarationIdentities :: !(Map MappedKey Text),-    impactUnsupportedProjectionSources :: ![UnsupportedProjectionSource]+  { roots :: ![MappedRoot],+    usePaths :: !(Map MappedKey [UsePath]),+    aggregateDeclarations :: !(Map MappedConsumer (Set MappedKey)),+    declarationConsumers :: !(Map MappedKey (Set MappedConsumer)),+    declarationEvidence :: !(Map MappedKey (Set MappedRootEvidence)),+    declarationConsequences :: !(Map MappedKey (Set MappedConsequence)),+    serviceDeclarations :: !(Set MappedKey),+    declarationIdentities :: !(Map MappedKey Text),+    unsupportedProjectionSources :: ![UnsupportedProjectionSource]   }   deriving stock (Eq, Show, Generic) @@ -156,25 +156,25 @@ -- inventory makes the declaration ownership boundary visible and leaves room -- for future non-aggregate roots. data SemanticImpactSnapshot = SemanticImpactSnapshot-  { snapshotMappedConsumers :: !(Map MappedKey (Set MappedConsumer)),-    snapshotMappedEvidence :: !(Maybe (Map MappedKey (Set MappedRootEvidence))),-    snapshotMappedConsequences :: !(Maybe (Map MappedKey (Set MappedConsequence))),-    snapshotServiceInventory :: !(Set MappedKey),-    snapshotDeclarationIdentities :: !(Map MappedKey Text)+  { mappedConsumers :: !(Map MappedKey (Set MappedConsumer)),+    mappedEvidence :: !(Maybe (Map MappedKey (Set MappedRootEvidence))),+    mappedConsequences :: !(Maybe (Map MappedKey (Set MappedConsequence))),+    serviceInventory :: !(Set MappedKey),+    declarationIdentities :: !(Map MappedKey Text)   }   deriving stock (Eq, Show, Generic)  -- | One declaration's before/after consumer explanation. Compatibility and -- generated-file writes deliberately remain outside this type. data MappedImpactDelta = MappedImpactDelta-  { impactDeclaration :: !MappedKey,-    impactPreviousConsumers :: !(Set MappedConsumer),-    impactCurrentConsumers :: !(Set MappedConsumer),-    impactPreviousEvidence :: !(Maybe (Set MappedRootEvidence)),-    impactCurrentEvidence :: !(Maybe (Set MappedRootEvidence)),-    impactPreviousConsequences :: !(Maybe (Set MappedConsequence)),-    impactCurrentConsequences :: !(Maybe (Set MappedConsequence)),-    impactServiceConformance :: !Bool+  { declaration :: !MappedKey,+    previousConsumers :: !(Set MappedConsumer),+    currentConsumers :: !(Set MappedConsumer),+    previousEvidence :: !(Maybe (Set MappedRootEvidence)),+    currentEvidence :: !(Maybe (Set MappedRootEvidence)),+    previousConsequences :: !(Maybe (Set MappedConsequence)),+    currentConsequences :: !(Maybe (Set MappedConsequence)),+    serviceConformance :: !Bool   }   deriving stock (Eq, Show, Generic) @@ -182,10 +182,10 @@ -- changed. A missing previous snapshot means legacy history, not an empty old -- graph; callers can still report the checked current consumers honestly. data SemanticImpactReport = SemanticImpactReport-  { semanticReportPrevious :: !(Maybe SemanticImpactSnapshot),-    semanticReportCurrent :: !SemanticImpactSnapshot,-    semanticReportDeclarations :: ![MappedKey],-    semanticReportDeltas :: ![MappedImpactDelta]+  { previous :: !(Maybe SemanticImpactSnapshot),+    current :: !SemanticImpactSnapshot,+    declarations :: ![MappedKey],+    deltas :: ![MappedImpactDelta]   }   deriving stock (Eq, Show, Generic) @@ -199,18 +199,18 @@           .= [ object                  ( [ "declaration" .= unMappedKey declaration,                      "consumers" .= map mappedConsumerIdentity (Set.toAscList declarationConsumers),-                     "identity" .= Map.findWithDefault "" declaration (snapshotDeclarationIdentities snapshot)+                     "identity" .= Map.findWithDefault "" declaration ((.declarationIdentities) snapshot)                    ]-                     <> maybe [] (\evidence -> ["consumerEvidence" .= Set.toAscList (Map.findWithDefault Set.empty declaration evidence)]) (snapshotMappedEvidence snapshot)-                     <> maybe [] (\consequences -> ["consequences" .= Set.toAscList (Map.findWithDefault Set.empty declaration consequences)]) (snapshotMappedConsequences snapshot)+                     <> maybe [] (\evidence -> ["consumerEvidence" .= Set.toAscList (Map.findWithDefault Set.empty declaration evidence)]) ((.mappedEvidence) snapshot)+                     <> maybe [] (\consequences -> ["consequences" .= Set.toAscList (Map.findWithDefault Set.empty declaration consequences)]) ((.mappedConsequences) snapshot)                  )-             | (declaration, declarationConsumers) <- Map.toAscList (snapshotMappedConsumers snapshot)+             | (declaration, declarationConsumers) <- Map.toAscList ((.mappedConsumers) snapshot)              ],-        "serviceInventory" .= map unMappedKey (Set.toAscList (snapshotServiceInventory snapshot))+        "serviceInventory" .= map unMappedKey (Set.toAscList ((.serviceInventory) snapshot))       ]         <> [ "mappedSurfaceEvidenceVersion" .= (1 :: Int)-           | isJust (snapshotMappedEvidence snapshot)-               || isJust (snapshotMappedConsequences snapshot)+           | isJust ((.mappedEvidence) snapshot)+               || isJust ((.mappedConsequences) snapshot)            ]  instance FromJSON SemanticImpactSnapshot where@@ -244,11 +244,11 @@     unless (maybe True (consequencesAgree declarationMap) consequences) (fail "semantic-impact consequences and consumer inventory differ")     pure       SemanticImpactSnapshot-        { snapshotMappedConsumers = declarationMap,-          snapshotMappedEvidence = evidence,-          snapshotMappedConsequences = consequences,-          snapshotServiceInventory = inventory,-          snapshotDeclarationIdentities = declarationIdentities+        { mappedConsumers = declarationMap,+          mappedEvidence = evidence,+          mappedConsequences = consequences,+          serviceInventory = inventory,+          declarationIdentities = declarationIdentities         }     where       parseDeclaration = withObject "SemanticImpactDeclaration" $ \row -> do@@ -266,13 +266,13 @@       distinct values = length values == Set.size (Set.fromList values)       evidenceAgrees consumers evidence =         and-          [ Set.map evidenceConsumer (Map.findWithDefault Set.empty declaration evidence) == declarationConsumers+          [ Set.map (.consumer) (Map.findWithDefault Set.empty declaration evidence) == declarationConsumers               && all operationAgrees (Set.toList (Map.findWithDefault Set.empty declaration evidence))           | (declaration, declarationConsumers) <- Map.toList consumers           ]-      operationAgrees evidence = case evidenceRootKind evidence of-        MappedProjectionEventRoot -> maybe False (not . T.null) (evidenceOperation evidence)-        _ -> evidenceOperation evidence == Nothing+      operationAgrees evidence = case (.rootKind) evidence of+        MappedProjectionEventRoot -> maybe False (not . T.null) ((.operation) evidence)+        _ -> (.operation) evidence == Nothing       consequencesAgree consumers consequences =         and           [ Set.fromList@@ -293,10 +293,10 @@ instance ToJSON MappedRootEvidence where   toJSON evidence =     object-      [ "consumer" .= mappedConsumerIdentity (evidenceConsumer evidence),-        "surface" .= mappedRootKindIdentity (evidenceRootKind evidence),-        "path" .= evidencePath evidence,-        "operation" .= evidenceOperation evidence+      [ "consumer" .= mappedConsumerIdentity ((.consumer) evidence),+        "surface" .= mappedRootKindIdentity ((.rootKind) evidence),+        "path" .= (.path) evidence,+        "operation" .= (.operation) evidence       ]  instance FromJSON MappedRootEvidence where@@ -337,14 +337,14 @@ instance ToJSON MappedImpactDelta where   toJSON delta =     object-      [ "declaration" .= unMappedKey (impactDeclaration delta),-        "previousConsumers" .= map mappedConsumerIdentity (Set.toAscList (impactPreviousConsumers delta)),-        "currentConsumers" .= map mappedConsumerIdentity (Set.toAscList (impactCurrentConsumers delta)),-        "previousConsumerEvidence" .= fmap Set.toAscList (impactPreviousEvidence delta),-        "currentConsumerEvidence" .= fmap Set.toAscList (impactCurrentEvidence delta),-        "previousConsequences" .= fmap Set.toAscList (impactPreviousConsequences delta),-        "currentConsequences" .= fmap Set.toAscList (impactCurrentConsequences delta),-        "serviceConformance" .= impactServiceConformance delta+      [ "declaration" .= unMappedKey ((.declaration) delta),+        "previousConsumers" .= map mappedConsumerIdentity (Set.toAscList ((.previousConsumers) delta)),+        "currentConsumers" .= map mappedConsumerIdentity (Set.toAscList ((.currentConsumers) delta)),+        "previousConsumerEvidence" .= fmap Set.toAscList ((.previousEvidence) delta),+        "currentConsumerEvidence" .= fmap Set.toAscList ((.currentEvidence) delta),+        "previousConsequences" .= fmap Set.toAscList ((.previousConsequences) delta),+        "currentConsequences" .= fmap Set.toAscList ((.currentConsequences) delta),+        "serviceConformance" .= (.serviceConformance) delta       ]  instance FromJSON MappedImpactDelta where@@ -352,9 +352,9 @@     declaration <- MappedKey <$> fields .: "declaration"     previousNames <- fields .: "previousConsumers"     currentNames <- fields .: "currentConsumers"-    previousEvidence <- fields .:? "previousConsumerEvidence"+    decodedPreviousEvidence <- fields .:? "previousConsumerEvidence"     currentEvidence <- fields .:? "currentConsumerEvidence"-    previousConsequences <- fields .:? "previousConsequences"+    decodedPreviousConsequences <- fields .:? "previousConsequences"     currentConsequences <- fields .:? "currentConsequences"     serviceConformance <- fields .: "serviceConformance"     previous <- traverse parseConsumerName previousNames@@ -363,14 +363,14 @@     unless (distinct current) (fail "duplicate current semantic-impact consumer")     pure       MappedImpactDelta-        { impactDeclaration = declaration,-          impactPreviousConsumers = Set.fromList previous,-          impactCurrentConsumers = Set.fromList current,-          impactPreviousEvidence = Set.fromList <$> previousEvidence,-          impactCurrentEvidence = Set.fromList <$> currentEvidence,-          impactPreviousConsequences = Set.fromList <$> previousConsequences,-          impactCurrentConsequences = Set.fromList <$> currentConsequences,-          impactServiceConformance = serviceConformance+        { declaration = declaration,+          previousConsumers = Set.fromList previous,+          currentConsumers = Set.fromList current,+          previousEvidence = Set.fromList <$> decodedPreviousEvidence,+          currentEvidence = Set.fromList <$> currentEvidence,+          previousConsequences = Set.fromList <$> decodedPreviousConsequences,+          currentConsequences = Set.fromList <$> currentConsequences,+          serviceConformance = serviceConformance         }     where       distinct values = length values == Set.size (Set.fromList values)@@ -381,41 +381,41 @@ semanticImpact :: TypeGraph -> SemanticImpact semanticImpact graph =   SemanticImpact-    { impactRoots = roots,-      impactUsePaths = pathsByDeclaration,-      impactAggregateDeclarations = aggregateDeclarations,-      impactDeclarationConsumers = declarationConsumers,-      impactDeclarationEvidence = declarationEvidence,-      impactDeclarationConsequences = Map.map (Set.unions . map consequencesForEvidence . Set.toAscList) declarationEvidence,-      impactServiceDeclarations = serviceDeclarations,-      impactDeclarationIdentities = Map.mapWithKey (declarationIdentity graph) (tgDeclarations graph),-      impactUnsupportedProjectionSources = tgUnsupportedProjectionSources graph+    { roots = roots,+      usePaths = pathsByDeclaration,+      aggregateDeclarations = aggregateDeclarations,+      declarationConsumers = declarationConsumers,+      declarationEvidence = declarationEvidence,+      declarationConsequences = Map.map (Set.unions . map consequencesForEvidence . Set.toAscList) declarationEvidence,+      serviceDeclarations = allServiceDeclarations,+      declarationIdentities = Map.mapWithKey (declarationIdentity graph) ((.declarations) graph),+      unsupportedProjectionSources = (.unsupportedProjectionSources) graph     }   where-    directRoots = map mappedRootFromUseSite (tgUseSites graph)-    roots = sort (directRoots <> concatMap derivedRoots (tgDerivedMappedConsumers graph))+    directRoots = map mappedRootFromUseSite ((.useSites) graph)+    roots = sort (directRoots <> concatMap derivedRoots ((.derivedMappedConsumers) graph))     derivedRoots consumer =       [ MappedRoot-          { mappedRootConsumer = DerivedProjectionConsumer consumer,-            mappedRootKind = MappedProjectionEventRoot,-            mappedRootUseSite = site,-            mappedRootDeclaration = declaration+          { consumer = DerivedProjectionConsumer consumer,+            kind = MappedProjectionEventRoot,+            useSite = site,+            declaration = declaration           }-      | site@(RootEventField aggregate _ _ declaration) <- tgUseSites graph,+      | site@(RootEventField aggregate _ _ declaration) <- (.useSites) graph,         aggregate == derivedAuthority consumer       ]     aggregateDeclarations =       Map.fromListWith         Set.union-        [ (mappedRootConsumer root, declarationClosure graph (mappedRootDeclaration root))+        [ ((.consumer) root, declarationClosure graph ((.declaration) root))         | root <- roots         ]-    serviceDeclarations = Map.keysSet (tgDeclarations graph)-    pathsByDeclaration = Map.fromSet (sort . usePaths graph . unMappedKey) serviceDeclarations+    allServiceDeclarations = Map.keysSet ((.declarations) graph)+    pathsByDeclaration = Map.fromSet (sort . usePaths graph . unMappedKey) allServiceDeclarations     declarationConsumers =       Map.unionWith         Set.union-        (Map.fromSet (const Set.empty) serviceDeclarations)+        (Map.fromSet (const Set.empty) allServiceDeclarations)         ( Map.fromListWith             Set.union             [ (declaration, Set.singleton consumer)@@ -428,23 +428,23 @@         (\_ paths -> Set.fromList (concatMap evidenceForPath paths))         pathsByDeclaration     evidenceForPath usePath =-      let directRoot = mappedRootFromUseSite (upRoot usePath)+      let directRoot = mappedRootFromUseSite ((.root) usePath)           direct =             MappedRootEvidence-              { evidenceConsumer = mappedRootConsumer directRoot,-                evidenceRootKind = mappedRootKind directRoot,-                evidencePath = renderUsePath usePath,-                evidenceOperation = Nothing+              { consumer = (.consumer) directRoot,+                rootKind = (.kind) directRoot,+                path = renderUsePath usePath,+                operation = Nothing               }           projections =             [ MappedRootEvidence-                { evidenceConsumer = DerivedProjectionConsumer derived,-                  evidenceRootKind = MappedProjectionEventRoot,-                  evidencePath = renderUsePath usePath,-                  evidenceOperation = Map.lookup derived (tgProjectionOperationalIdentities graph)+                { consumer = DerivedProjectionConsumer derived,+                  rootKind = MappedProjectionEventRoot,+                  path = renderUsePath usePath,+                  operation = Map.lookup derived ((.projectionOperationalIdentities) graph)                 }             | aggregate <- maybeToList (eventAuthority usePath),-              derived <- tgDerivedMappedConsumers graph,+              derived <- (.derivedMappedConsumers) graph,               derivedAuthority derived == aggregate             ]        in direct : projections@@ -455,20 +455,24 @@ -- query root comes from 'CheckedRouterSelection'. semanticImpactForService :: CheckedService -> TypeGraph -> SemanticImpact semanticImpactForService service graph =-  base-    { impactRoots = sort (impactRoots base <> map selectionEvidenceRoot extraEvidence),-      impactAggregateDeclarations = Map.unionWith Set.union (impactAggregateDeclarations base) declarationsByConsumer,-      impactDeclarationConsumers = Map.unionWith Set.union (impactDeclarationConsumers base) consumersByDeclaration,-      impactDeclarationEvidence = Map.unionWith Set.union (impactDeclarationEvidence base) evidenceByDeclaration,-      impactDeclarationConsequences = Map.unionWith Set.union (impactDeclarationConsequences base) consequencesByDeclaration+  SemanticImpact+    { roots = sort (base.roots <> map (.root) extraEvidence),+      usePaths = base.usePaths,+      aggregateDeclarations = Map.unionWith Set.union base.aggregateDeclarations declarationsByConsumer,+      declarationConsumers = Map.unionWith Set.union base.declarationConsumers consumersByDeclaration,+      declarationEvidence = Map.unionWith Set.union base.declarationEvidence evidenceByDeclaration,+      declarationConsequences = Map.unionWith Set.union base.declarationConsequences consequencesByDeclaration,+      serviceDeclarations = base.serviceDeclarations,+      declarationIdentities = base.declarationIdentities,+      unsupportedProjectionSources = base.unsupportedProjectionSources     }   where     base = semanticImpact graph     extraEvidence = concatMap checkedRouterEvidence checkedSelections     checkedSelections =-      [ (rtId router, checked)-      | NRouter router <- specNodes (checkedSpec service),-        ResolveDeclarative {} <- [rvSource (rtResolve router)],+      [ ((.id) router, checked)+      | NRouter router <- (.nodes) (checkedSpec service),+        ResolveDeclarative {} <- [(.source) ((.resolve) router)],         let checked = case checkRouterSelection (checkedLanguageContract service) graph (checkedSpec service) router of               Right value -> value               Left failures -> error ("validated declarative router selection did not check: " <> show failures)@@ -476,15 +480,15 @@     declarationsByConsumer =       Map.fromListWith         Set.union-        [ (mappedRootConsumer root, declarationClosure graph (mappedRootDeclaration root))+        [ ((.consumer) root, declarationClosure graph ((.declaration) root))         | SelectionEvidence root _ <- extraEvidence         ]     consumersByDeclaration =       Map.fromListWith         Set.union-        [ (declaration, Set.singleton (mappedRootConsumer root))+        [ (declaration, Set.singleton ((.consumer) root))         | SelectionEvidence root _ <- extraEvidence,-          declaration <- Set.toList (declarationClosure graph (mappedRootDeclaration root))+          declaration <- Set.toList (declarationClosure graph ((.declaration) root))         ]     evidenceByDeclaration =       Map.fromListWith@@ -492,14 +496,14 @@         [ ( declaration,             Set.singleton               MappedRootEvidence-                { evidenceConsumer = mappedRootConsumer root,-                  evidenceRootKind = mappedRootKind root,-                  evidencePath = path,-                  evidenceOperation = Nothing+                { consumer = (.consumer) root,+                  rootKind = (.kind) root,+                  path = path,+                  operation = Nothing                 }           )         | SelectionEvidence root path <- extraEvidence,-          declaration <- Set.toList (declarationClosure graph (mappedRootDeclaration root))+          declaration <- Set.toList (declarationClosure graph ((.declaration) root))         ]     consequencesByDeclaration =       Map.map@@ -507,8 +511,8 @@         evidenceByDeclaration  data SelectionEvidence = SelectionEvidence-  { selectionEvidenceRoot :: !MappedRoot,-    selectionEvidencePath :: !Text+  { root :: !MappedRoot,+    path :: !Text   }  checkedRouterEvidence :: (Name, CheckedRouterSelection) -> [SelectionEvidence]@@ -516,14 +520,14 @@   where     queryInputEvidence =       [ selectionEvidence router SelectionQueryInput MappedRouterSelectionQueryInputRoot site ("router " <> router <> " selection query input")-      | site@RootReadModelQueryInput {} <- checkedUseSites selection+      | site@RootReadModelQueryInput {} <- (.useSites) selection       ]     expressionEvidence =-      checkedExpressionEvidence router selection SelectionPredicate MappedRouterSelectionPredicateRoot "predicate" (checkedPredicate selection)-        <> checkedExpressionEvidence router selection SelectionRecipient MappedRouterSelectionRecipientRoot "recipient" (checkedRecipient selection)+      checkedExpressionEvidence router selection SelectionPredicate MappedRouterSelectionPredicateRoot "predicate" ((.predicate) selection)+        <> checkedExpressionEvidence router selection SelectionRecipient MappedRouterSelectionRecipientRoot "recipient" ((.recipient) selection)         <> concat           [ checkedExpressionEvidence router selection (SelectionCommandField field) MappedRouterSelectionCommandFieldRoot ("command field " <> field) expression-          | (field, expression) <- Map.toAscList (checkedCommandFields selection)+          | (field, expression) <- Map.toAscList ((.commandFields) selection)           ]  checkedExpressionEvidence :: Name -> CheckedRouterSelection -> RouterSelectionPosition -> MappedRootKind -> Text -> CheckedScalarExpr -> [SelectionEvidence]@@ -536,20 +540,20 @@ selectionEvidence :: Name -> RouterSelectionPosition -> MappedRootKind -> UseSite -> Text -> SelectionEvidence selectionEvidence router position rootKind site path =   SelectionEvidence-    { selectionEvidenceRoot =+    { root =         MappedRoot-          { mappedRootConsumer = RouterSelectionConsumer router position,-            mappedRootKind = rootKind,-            mappedRootUseSite = site,-            mappedRootDeclaration = useSiteDeclaration site+          { consumer = RouterSelectionConsumer router position,+            kind = rootKind,+            useSite = site,+            declaration = useSiteDeclaration site           },-      selectionEvidencePath = path+      path = path     }  selectionRootSites :: SelectionRoot -> CheckedRouterSelection -> [UseSite] selectionRootSites root selection =   [ site-  | site <- checkedUseSites selection,+  | site <- (.useSites) selection,     case (root, site) of       (SelectionInput, RootReadModelQueryInput {}) -> True       (SelectionRow, RootReadModelQueryResult {}) -> True@@ -557,7 +561,7 @@   ]  checkedScalarPaths :: CheckedScalarExpr -> [(SelectionRoot, [CheckedSelectionPathSegment])]-checkedScalarPaths expression = case checkedScalarNode expression of+checkedScalarPaths expression = case (.node) expression of   CheckedPath root segments -> [(root, segments)]   CheckedTextLiteral _ -> []   CheckedIntegralLiteral _ -> []@@ -568,12 +572,12 @@  renderCheckedPath :: SelectionRoot -> [CheckedSelectionPathSegment] -> Text renderCheckedPath root segments =-  rootLabel <> T.concat ["." <> checkedPathField segment <> wireLabel segment | segment <- segments]+  rootLabel <> T.concat ["." <> (.field) segment <> wireLabel segment | segment <- segments]   where     rootLabel = case root of SelectionInput -> "input"; SelectionRow -> "row"     wireLabel segment-      | checkedPathField segment == checkedPathWireKey segment = ""-      | otherwise = " as '" <> checkedPathWireKey segment <> "'"+      | (.field) segment == (.wireKey) segment = ""+      | otherwise = " as '" <> (.wireKey) segment <> "'"  useSiteDeclaration :: UseSite -> MappedKey useSiteDeclaration = \case@@ -586,35 +590,35 @@  consequencesForMappedEvidence :: TypeGraph -> MappedRootEvidence -> Set MappedConsequence consequencesForMappedEvidence graph evidence =-  Set.fromList (MappedConsumerBuild (evidenceConsumer evidence) : surfaceConsequences)+  Set.fromList (MappedConsumerBuild ((.consumer) evidence) : surfaceConsequences)   where-    surfaceConsequences = case evidenceRootKind evidence of+    surfaceConsequences = case (.rootKind) evidence of       MappedCommandFieldRoot -> []-      MappedEventFieldRoot -> case evidenceConsumer evidence of+      MappedEventFieldRoot -> case (.consumer) evidence of         AggregateConsumer aggregate -> [MappedPrivateEventHistory aggregate]         _ -> []-      MappedRegisterRoot -> case evidenceConsumer evidence of+      MappedRegisterRoot -> case (.consumer) evidence of         AggregateConsumer aggregate -> [MappedSnapshotHydration aggregate]         _ -> []-      MappedWorkqueueFieldRoot -> case evidenceConsumer evidence of+      MappedWorkqueueFieldRoot -> case (.consumer) evidence of         WorkqueueConsumer workqueue -> [MappedWorkqueueHistory workqueue]         _ -> []-      MappedReadModelQueryInputRoot -> case evidenceConsumer evidence of+      MappedReadModelQueryInputRoot -> case (.consumer) evidence of         ReadModelQueryConsumer readModel MappedQueryInput -> [MappedQueryApi readModel MappedQueryInput]         _ -> []-      MappedReadModelQueryResultRoot -> case evidenceConsumer evidence of+      MappedReadModelQueryResultRoot -> case (.consumer) evidence of         ReadModelQueryConsumer readModel MappedQueryResult -> [MappedQueryApi readModel MappedQueryResult]         _ -> []       MappedRouterSelectionQueryInputRoot -> selectionConsequences       MappedRouterSelectionPredicateRoot -> selectionConsequences       MappedRouterSelectionRecipientRoot -> selectionConsequences       MappedRouterSelectionCommandFieldRoot -> selectionConsequences-      MappedProjectionEventRoot -> case evidenceConsumer evidence of+      MappedProjectionEventRoot -> case (.consumer) evidence of         DerivedProjectionConsumer derived ->           MappedProjectionHandlerReview derived-            : [MappedProjectionRebuild derived groupName | groupName <- maybeToList (Map.lookup derived (tgReplayableProjectionGroups graph))]+            : [MappedProjectionRebuild derived groupName | groupName <- maybeToList (Map.lookup derived ((.replayableProjectionGroups) graph))]         _ -> []-    selectionConsequences = case evidenceConsumer evidence of+    selectionConsequences = case (.consumer) evidence of       RouterSelectionConsumer router _ -> [MappedRouterSelectionBuild router, MappedRouterSelectionCoordinationReview router]       _ -> [] @@ -622,11 +626,11 @@ semanticImpactSnapshot :: SemanticImpact -> SemanticImpactSnapshot semanticImpactSnapshot impact =   SemanticImpactSnapshot-    { snapshotMappedConsumers = impactDeclarationConsumers impact,-      snapshotMappedEvidence = Just (impactDeclarationEvidence impact),-      snapshotMappedConsequences = Just (impactDeclarationConsequences impact),-      snapshotServiceInventory = impactServiceDeclarations impact,-      snapshotDeclarationIdentities = impactDeclarationIdentities impact+    { mappedConsumers = (.declarationConsumers) impact,+      mappedEvidence = Just ((.declarationEvidence) impact),+      mappedConsequences = Just ((.declarationConsequences) impact),+      serviceInventory = (.serviceDeclarations) impact,+      declarationIdentities = (.declarationIdentities) impact     }  -- | Compare consumer membership, service-inventory membership, and canonical@@ -635,28 +639,28 @@ diffSemanticImpact previous current =   [ delta   | delta <- mappedImpactForDeclarations allDeclarations previous current,-    impactPreviousConsumers delta /= impactCurrentConsumers delta-      || impactPreviousEvidence delta /= impactCurrentEvidence delta-      || impactPreviousConsequences delta /= impactCurrentConsequences delta-      || serviceMember previous (impactDeclaration delta) /= serviceMember current (impactDeclaration delta)-      || declarationIdentityAt previous (impactDeclaration delta) /= declarationIdentityAt current (impactDeclaration delta)+    (.previousConsumers) delta /= (.currentConsumers) delta+      || (.previousEvidence) delta /= (.currentEvidence) delta+      || (.previousConsequences) delta /= (.currentConsequences) delta+      || serviceMember previous ((.declaration) delta) /= serviceMember current ((.declaration) delta)+      || declarationIdentityAt previous ((.declaration) delta) /= declarationIdentityAt current ((.declaration) delta)   ]   where-    allDeclarations = Set.toAscList (snapshotServiceInventory previous <> snapshotServiceInventory current)+    allDeclarations = Set.toAscList ((.serviceInventory) previous <> (.serviceInventory) current)  -- | Explain an authoritative set of changed mapped declarations. Keys are -- sorted and deduplicated; a key absent from both inventories is ignored. mappedImpactForDeclarations :: [MappedKey] -> SemanticImpactSnapshot -> SemanticImpactSnapshot -> [MappedImpactDelta] mappedImpactForDeclarations declarations previous current =   [ MappedImpactDelta-      { impactDeclaration = declaration,-        impactPreviousConsumers = snapshotConsumers previous declaration,-        impactCurrentConsumers = snapshotConsumers current declaration,-        impactPreviousEvidence = snapshotEvidence previous declaration,-        impactCurrentEvidence = snapshotEvidence current declaration,-        impactPreviousConsequences = snapshotConsequences previous declaration,-        impactCurrentConsequences = snapshotConsequences current declaration,-        impactServiceConformance = serviceMember previous declaration || serviceMember current declaration+      { declaration = declaration,+        previousConsumers = snapshotConsumers previous declaration,+        currentConsumers = snapshotConsumers current declaration,+        previousEvidence = snapshotEvidence previous declaration,+        currentEvidence = snapshotEvidence current declaration,+        previousConsequences = snapshotConsequences previous declaration,+        currentConsequences = snapshotConsequences current declaration,+        serviceConformance = serviceMember previous declaration || serviceMember current declaration       }   | declaration <- Set.toAscList (Set.fromList declarations),     serviceMember previous declaration || serviceMember current declaration@@ -667,28 +671,28 @@ semanticImpactReport :: Maybe SemanticImpactSnapshot -> SemanticImpactSnapshot -> [MappedKey] -> SemanticImpactReport semanticImpactReport previous current declarations =   SemanticImpactReport-    { semanticReportPrevious = previous,-      semanticReportCurrent = current,-      semanticReportDeclarations = canonicalDeclarations,-      semanticReportDeltas = maybe [] (\old -> mappedImpactForDeclarations canonicalDeclarations old current) previous+    { previous = previous,+      current = current,+      declarations = canonicalDeclarations,+      deltas = maybe [] (\old -> mappedImpactForDeclarations canonicalDeclarations old current) previous     }   where     canonicalDeclarations = Set.toAscList (Set.fromList declarations)  snapshotConsumers :: SemanticImpactSnapshot -> MappedKey -> Set MappedConsumer-snapshotConsumers snapshot declaration = Map.findWithDefault Set.empty declaration (snapshotMappedConsumers snapshot)+snapshotConsumers snapshot declaration = Map.findWithDefault Set.empty declaration ((.mappedConsumers) snapshot)  snapshotEvidence :: SemanticImpactSnapshot -> MappedKey -> Maybe (Set MappedRootEvidence)-snapshotEvidence snapshot declaration = (Map.findWithDefault Set.empty declaration) <$> snapshotMappedEvidence snapshot+snapshotEvidence snapshot declaration = (Map.findWithDefault Set.empty declaration) <$> (.mappedEvidence) snapshot  snapshotConsequences :: SemanticImpactSnapshot -> MappedKey -> Maybe (Set MappedConsequence)-snapshotConsequences snapshot declaration = (Map.findWithDefault Set.empty declaration) <$> snapshotMappedConsequences snapshot+snapshotConsequences snapshot declaration = (Map.findWithDefault Set.empty declaration) <$> (.mappedConsequences) snapshot  serviceMember :: SemanticImpactSnapshot -> MappedKey -> Bool-serviceMember snapshot declaration = declaration `Set.member` snapshotServiceInventory snapshot+serviceMember snapshot declaration = declaration `Set.member` (.serviceInventory) snapshot  declarationIdentityAt :: SemanticImpactSnapshot -> MappedKey -> Maybe Text-declarationIdentityAt snapshot declaration = Map.lookup declaration (snapshotDeclarationIdentities snapshot)+declarationIdentityAt snapshot declaration = Map.lookup declaration ((.declarationIdentities) snapshot)  -- | Canonical identity for mapped declaration facts that 'MappedDiff' treats -- as changes. Source locations and declaration order are deliberately absent.@@ -700,31 +704,31 @@   where     structuralParts structural shape =       [ "structural",-        sourceIdentity (sdHaskell structural),-        unQualifiedValueName (sdBinding structural),-        unBindingVersion (sdBindingVersion structural),-        unCanonicalTypeId (sdCanonical structural),-        unQualifiedValueName (sdFixtures structural),-        maybe "" unQualifiedValueName (sdInitial structural),+        sourceIdentity ((.haskell) structural),+        unQualifiedValueName ((.binding) structural),+        unBindingVersion ((.bindingVersion) structural),+        unCanonicalTypeId ((.canonical) structural),+        unQualifiedValueName ((.fixtures) structural),+        maybe "" unQualifiedValueName ((.initial) structural),         wireFingerprint graph (unMappedKey key),         structuralPresentation shape       ]     opaqueParts opaque =       [ "opaque",-        sourceIdentity (odHaskell opaque),-        unCodecIdentity (odCodecIdentity opaque),-        unCodecVersion (odCodecVersion opaque),-        unQualifiedValueName (odFixtures opaque),-        maybe "" unQualifiedValueName (odInitial opaque),+        sourceIdentity ((.haskell) opaque),+        unCodecIdentity ((.codecIdentity) opaque),+        unCodecVersion ((.codecVersion) opaque),+        unQualifiedValueName ((.fixtures) opaque),+        maybe "" unQualifiedValueName ((.initial) opaque),         wireFingerprint graph (unMappedKey key)       ]-    sourceIdentity source = T.intercalate ":" [hsPackage source, hsModule source, hsType source]+    sourceIdentity source = T.intercalate ":" [(.package) source, (.moduleName) source, (.valueType) source]     structuralPresentation (RRecord constructor _ fields) =-      "record:" <> constructor <> ":" <> T.intercalate "," [rwfHaskell field <> "=" <> rwfKey field | field <- sortOn rwfKey fields]+      "record:" <> constructor <> ":" <> T.intercalate "," [(.haskell) field <> "=" <> (.key) field | field <- sortOn (\field -> field.key) fields]     structuralPresentation (REnum entries) =-      "enum:" <> T.intercalate "," [weCtor entry <> "=" <> weTag entry | entry <- sortOn weTag entries]+      "enum:" <> T.intercalate "," [(.ctor) entry <> "=" <> (.tag) entry | entry <- sortOn (.tag) entries]     structuralPresentation (RUnion _ arms) =-      "union:" <> T.intercalate "," [rwaTag arm | arm <- sortOn rwaTag arms]+      "union:" <> T.intercalate "," [(.tag) arm | arm <- sortOn (.tag) arms]  mappedConsumerIdentity :: MappedConsumer -> Name mappedConsumerIdentity (AggregateConsumer aggregate) = aggregate@@ -824,17 +828,17 @@   [ ( T.intercalate         "/"         [ "mapped-surface",-          mappedRootKindIdentity (evidenceRootKind evidence),-          mappedConsumerIdentity (evidenceConsumer evidence),+          mappedRootKindIdentity ((.rootKind) evidence),+          mappedConsumerIdentity ((.consumer) evidence),           unMappedKey declaration,-          evidencePath evidence+          (.path) evidence         ],       T.intercalate "," (map mappedConsequenceIdentity (Set.toAscList consequences))-        <> maybe "" (";projection-operation:" <>) (evidenceOperation evidence)+        <> maybe "" (";projection-operation:" <>) ((.operation) evidence)     )-  | (declaration, evidenceValues) <- Map.toAscList (impactDeclarationEvidence impact),+  | (declaration, evidenceValues) <- Map.toAscList ((.declarationEvidence) impact),     evidence <- Set.toAscList evidenceValues,-    let consequences = Map.findWithDefault Set.empty declaration (impactDeclarationConsequences impact)+    let consequences = Map.findWithDefault Set.empty declaration ((.declarationConsequences) impact)   ]  derivedAuthority :: DerivedMappedConsumer -> Name@@ -845,78 +849,78 @@ aggregateMappedRoots :: SemanticImpact -> Name -> [MappedRoot] aggregateMappedRoots impact aggregate =   [ root-  | root <- impactRoots impact,-    mappedRootConsumer root == AggregateConsumer aggregate+  | root <- (.roots) impact,+    (.consumer) root == AggregateConsumer aggregate   ]  -- | Return one aggregate's transitive mapped declaration closure in stable -- declaration-key order. aggregateMappedClosure :: SemanticImpact -> Name -> [MappedKey] aggregateMappedClosure impact aggregate =-  maybe [] Set.toAscList (Map.lookup (AggregateConsumer aggregate) (impactAggregateDeclarations impact))+  maybe [] Set.toAscList (Map.lookup (AggregateConsumer aggregate) ((.aggregateDeclarations) impact))  -- | Return every aggregate that can consume a declaration in stable order. -- Unknown and intentionally unused declarations both have no consumers; use -- 'serviceMappedInventory' to distinguish whether a declaration exists. mappedDeclarationConsumers :: SemanticImpact -> MappedKey -> [MappedConsumer] mappedDeclarationConsumers impact declaration =-  maybe [] Set.toAscList (Map.lookup declaration (impactDeclarationConsumers impact))+  maybe [] Set.toAscList (Map.lookup declaration ((.declarationConsumers) impact))  -- | Return every checked declaration, including declarations with no current -- aggregate consumer, in stable order. serviceMappedInventory :: SemanticImpact -> [MappedKey]-serviceMappedInventory = Set.toAscList . impactServiceDeclarations+serviceMappedInventory = Set.toAscList . (.serviceDeclarations)  declarationClosure :: TypeGraph -> MappedKey -> Set MappedKey declarationClosure graph root =-  Set.insert root (Map.findWithDefault Set.empty root (tgReachability graph))+  Set.insert root (Map.findWithDefault Set.empty root ((.reachability) graph))  mappedRootFromUseSite :: UseSite -> MappedRoot mappedRootFromUseSite site@(RootCommandField aggregate _ _ declaration) =   MappedRoot-    { mappedRootConsumer = AggregateConsumer aggregate,-      mappedRootKind = MappedCommandFieldRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = AggregateConsumer aggregate,+      kind = MappedCommandFieldRoot,+      useSite = site,+      declaration = declaration     } mappedRootFromUseSite site@(RootEventField aggregate _ _ declaration) =   MappedRoot-    { mappedRootConsumer = AggregateConsumer aggregate,-      mappedRootKind = MappedEventFieldRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = AggregateConsumer aggregate,+      kind = MappedEventFieldRoot,+      useSite = site,+      declaration = declaration     } mappedRootFromUseSite site@(RootRegister aggregate _ declaration) =   MappedRoot-    { mappedRootConsumer = AggregateConsumer aggregate,-      mappedRootKind = MappedRegisterRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = AggregateConsumer aggregate,+      kind = MappedRegisterRoot,+      useSite = site,+      declaration = declaration     } mappedRootFromUseSite site@(RootWorkqueueField workqueue _ declaration) =   MappedRoot-    { mappedRootConsumer = WorkqueueConsumer workqueue,-      mappedRootKind = MappedWorkqueueFieldRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = WorkqueueConsumer workqueue,+      kind = MappedWorkqueueFieldRoot,+      useSite = site,+      declaration = declaration     } mappedRootFromUseSite site@(RootReadModelQueryInput readModel declaration) =   MappedRoot-    { mappedRootConsumer = ReadModelQueryConsumer readModel MappedQueryInput,-      mappedRootKind = MappedReadModelQueryInputRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = ReadModelQueryConsumer readModel MappedQueryInput,+      kind = MappedReadModelQueryInputRoot,+      useSite = site,+      declaration = declaration     } mappedRootFromUseSite site@(RootReadModelQueryResult readModel declaration) =   MappedRoot-    { mappedRootConsumer = ReadModelQueryConsumer readModel MappedQueryResult,-      mappedRootKind = MappedReadModelQueryResultRoot,-      mappedRootUseSite = site,-      mappedRootDeclaration = declaration+    { consumer = ReadModelQueryConsumer readModel MappedQueryResult,+      kind = MappedReadModelQueryResultRoot,+      useSite = site,+      declaration = declaration     }  eventAuthority :: UsePath -> Maybe Name-eventAuthority UsePath {upRoot = RootEventField aggregate _ _ _} = Just aggregate+eventAuthority UsePath {root = RootEventField aggregate _ _ _} = Just aggregate eventAuthority _ = Nothing  maybeToList :: Maybe value -> [value]

src/Keiro/Dsl/ServiceHarness.hs view

@@ -17,7 +17,7 @@ import Keiro.Dsl.Harness (processHarnessFactValues, routerHarnessFactValuesForService, workflowHarnessFactValues) import Keiro.Dsl.LanguageVersion (LanguageFeature (MappedConsumerSurfaceSyntax), languageSupportsFeature) import Keiro.Dsl.Scaffold (Context, ModuleKind (Generated), ScaffoldModule (..), contextGeneratedPrefix, genPrefixFor, generatedBanner, pascal)-import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedSpec, checkedTypeGraph, effectiveContractLanguageVersion)+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedSpec, checkedTypeGraph) import Keiro.Dsl.SemanticImpact (mappedSurfaceFactValues, semanticImpactForService) import Keiro.Dsl.StructuralConformance (hasStructuralConformance, structuralConformanceModuleName) import Keiro.Dsl.Validate (nodeIdentity)@@ -59,10 +59,10 @@     moduleName = serviceConformanceModuleName ctx     facade =       ScaffoldModule-        { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-          moduleText = renderServiceHarness ctx service,+        { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+          text = renderServiceHarness ctx service,           kind = Generated,-          origin = "context " <> specContext (checkedSpec service) <> " service conformance facade"+          origin = "context " <> (.context) (checkedSpec service) <> " service conformance facade"         }  renderServiceHarness :: Context -> CheckedService -> Text@@ -112,11 +112,11 @@  harnessModuleName :: Context -> Node -> Text harnessModuleName ctx = \case-  NAggregate aggregate -> genPrefixFor ctx (aggName aggregate) <> ".Harness"-  NProcess process -> genPrefixFor ctx (procId process) <> ".ProcessHarness"-  NRouter router -> genPrefixFor ctx (rtId router) <> ".RouterHarness"-  NReadModel readModel -> genPrefixFor ctx (pascal (rmName readModel)) <> ".ReadModelHarness"-  NWorkflow workflow -> genPrefixFor ctx (wfId workflow) <> ".WorkflowFacts"+  NAggregate aggregate -> genPrefixFor ctx ((.name) aggregate) <> ".Harness"+  NProcess process -> genPrefixFor ctx ((.id) process) <> ".ProcessHarness"+  NRouter router -> genPrefixFor ctx ((.id) router) <> ".RouterHarness"+  NReadModel readModel -> genPrefixFor ctx (pascal ((.name) readModel)) <> ".ReadModelHarness"+  NWorkflow workflow -> genPrefixFor ctx ((.id) workflow) <> ".WorkflowFacts"   node -> error ("service harness requested a module for unsupported node " <> show (nodeIdentity node))  renderChecks :: Bool -> [(Node, Text)] -> [Text]@@ -140,9 +140,9 @@ checkExpression :: (Node, Text) -> Text checkExpression (node, alias) = case node of   NAggregate aggregate ->-    "[(\"aggregate/" <> aggName aggregate <> "/\" <> fact, passed) | (fact, passed) <- " <> alias <> ".harnessAssertions]"+    "[(\"aggregate/" <> (.name) aggregate <> "/\" <> fact, passed) | (fact, passed) <- " <> alias <> ".harnessAssertions]"   NReadModel readModel ->-    "[(\"readmodel/" <> rmName readModel <> "/\" <> fact, passed) | (fact, passed) <- " <> alias <> ".readModelFactResults]"+    "[(\"readmodel/" <> (.name) readModel <> "/\" <> fact, passed) | (fact, passed) <- " <> alias <> ".readModelFactResults]"   _ -> error "checkExpression called for a fact-only node"  renderFacts :: [(Text, Text)] -> [(Node, Text)] -> [Text]@@ -182,7 +182,7 @@  serviceHarnessNodes :: CheckedService -> [Node] serviceHarnessNodes =-  sortOn sortKey . filter (\node -> producesChecks node || producesFacts node) . specNodes . checkedSpec+  sortOn sortKey . filter (\node -> producesChecks node || producesFacts node) . (.nodes) . checkedSpec   where     sortKey node = let (kindName, nodeName, _) = nodeIdentity node in (kindName, nodeName) @@ -212,7 +212,7 @@ surfaceFactValues service   | not       ( languageSupportsFeature-          (effectiveContractLanguageVersion (checkedLanguageContract service))+          ((.contractLanguageVersion) (checkedLanguageContract service))           MappedConsumerSurfaceSyntax       ) =       []

src/Keiro/Dsl/SidecarMigration.hs view

@@ -23,7 +23,7 @@ import Data.Text qualified as T import Data.Text.IO qualified as TIO import Keiro.Dsl.ConformancePackage-  ( ConformancePackagePlan (cppDirectory),+  ( ConformancePackagePlan (..),     parseLegacyConformancePackageRecord,     renderConformancePackageRecord,   )@@ -45,19 +45,25 @@   deriving stock (Eq, Show)  data SidecarMove = SidecarMove-  { sidecarOldPath :: !FilePath,-    sidecarNewPath :: !FilePath,-    sidecarBackupPath :: !(Maybe FilePath),-    sidecarMoveDisposition :: !SidecarMoveDisposition+  { oldPath :: !FilePath,+    newPath :: !FilePath,+    backupPath :: !(Maybe FilePath),+    moveDisposition :: !SidecarMoveDisposition   }   deriving stock (Eq, Show) -data PreparedSidecarMove = PreparedSidecarMove-  { preparedSidecarMove :: !SidecarMove,-    preparedConvertedContents :: !(Maybe Text)-  }+data PreparedSidecarMove+  = PreparedSidecarRename !SidecarMove+  | PreparedSidecarRetirement !SidecarMove !FilePath+  | PreparedSidecarConversion !SidecarMove !FilePath !Text   deriving stock (Eq, Show) +preparedSidecarMove :: PreparedSidecarMove -> SidecarMove+preparedSidecarMove = \case+  PreparedSidecarRename move -> move+  PreparedSidecarRetirement move _ -> move+  PreparedSidecarConversion move _ _ -> move+ -- | Inspect the two scope-specific sidecars and the optional generated -- conformance package. An old-name file always produces a move: either a direct -- rename when the new path is absent, or retirement when the new path is already@@ -85,7 +91,7 @@       moves = [move | Right (Just move) <- results]   pure $ if null errors then Right moves else Left errors   where-    plannedDirectory = fmap cppDirectory conformancePlan+    plannedDirectory = fmap (.directory) conformancePlan     plannedDirectories = maybe [] (: []) plannedDirectory  -- | Directories under @out@ holding a legacy conformance record, excluding the@@ -149,16 +155,13 @@         then prepareRetirement out oldRelative newRelative         else           pure . Right . Just $-            PreparedSidecarMove-              { preparedSidecarMove =-                  SidecarMove-                    { sidecarOldPath = oldRelative,-                      sidecarNewPath = newRelative,-                      sidecarBackupPath = Nothing,-                      sidecarMoveDisposition = RenameSidecar-                    },-                preparedConvertedContents = Nothing-              }+            PreparedSidecarRename+              SidecarMove+                { oldPath = oldRelative,+                  newPath = newRelative,+                  backupPath = Nothing,+                  moveDisposition = RenameSidecar+                }  planConformance :: FilePath -> FilePath -> FilePath -> IO (Either Text (Maybe PreparedSidecarMove)) planConformance out oldRelative newRelative = do@@ -180,16 +183,15 @@                 then pure (Left (T.pack oldRelative <> ": sidecar migration backup already exists at " <> T.pack backupRelative))                 else                   pure . Right . Just $-                    PreparedSidecarMove-                      { preparedSidecarMove =-                          SidecarMove-                            { sidecarOldPath = oldRelative,-                              sidecarNewPath = newRelative,-                              sidecarBackupPath = Just backupRelative,-                              sidecarMoveDisposition = ConvertLegacyConformanceLedger-                            },-                        preparedConvertedContents = Just (preserveBanner legacyContents <> renderConformancePackageRecord record)-                      }+                    PreparedSidecarConversion+                      SidecarMove+                        { oldPath = oldRelative,+                          newPath = newRelative,+                          backupPath = Just backupRelative,+                          moveDisposition = ConvertLegacyConformanceLedger+                        }+                      backupRelative+                      (preserveBanner legacyContents <> renderConformancePackageRecord record)  prepareRetirement :: FilePath -> FilePath -> FilePath -> IO (Either Text (Maybe PreparedSidecarMove)) prepareRetirement out oldRelative newRelative = do@@ -199,16 +201,14 @@     then pure (Left (T.pack oldRelative <> ": sidecar migration backup already exists at " <> T.pack backupRelative))     else       pure . Right . Just $-        PreparedSidecarMove-          { preparedSidecarMove =-              SidecarMove-                { sidecarOldPath = oldRelative,-                  sidecarNewPath = newRelative,-                  sidecarBackupPath = Just backupRelative,-                  sidecarMoveDisposition = RetireLegacySidecar-                },-            preparedConvertedContents = Nothing-          }+        PreparedSidecarRetirement+          SidecarMove+            { oldPath = oldRelative,+              newPath = newRelative,+              backupPath = Just backupRelative,+              moveDisposition = RetireLegacySidecar+            }+          backupRelative  sidecarBackupRelative :: FilePath -> FilePath sidecarBackupRelative oldRelative = sidecarBackupRootName </> "sidecar-v1" </> oldRelative@@ -223,27 +223,22 @@ applyPreparedSidecarMoves :: FilePath -> [PreparedSidecarMove] -> IO () applyPreparedSidecarMoves out = mapM_ applyOne   where-    applyOne prepared = case sidecarMoveDisposition move of-      RenameSidecar -> do+    applyOne = \case+      PreparedSidecarRename move -> do+        let oldPath = out </> (.oldPath) move+            newPath = out </> (.newPath) move         createDirectoryIfMissing True (takeDirectory newPath)         renameFile oldPath newPath-      RetireLegacySidecar -> retire move oldPath-      ConvertLegacyConformanceLedger -> case preparedConvertedContents prepared of-        Nothing -> error "prepared conformance sidecar conversion lacks converted contents"-        Just converted -> do-          writeTextAtomic newPath converted-          retire move oldPath-      where-        move = preparedSidecarMove prepared-        oldPath = out </> sidecarOldPath move-        newPath = out </> sidecarNewPath move+      PreparedSidecarRetirement move backupRelative ->+        retire (out </> (.oldPath) move) backupRelative+      PreparedSidecarConversion move backupRelative converted -> do+        writeTextAtomic (out </> (.newPath) move) converted+        retire (out </> (.oldPath) move) backupRelative -    retire move oldPath = case sidecarBackupPath move of-      Nothing -> error "prepared sidecar retirement lacks a backup path"-      Just backupRelative -> do-        let backupPath = out </> backupRelative-        createDirectoryIfMissing True (takeDirectory backupPath)-        renameFile oldPath backupPath+    retire oldPath backupRelative = do+      let backupPath = out </> backupRelative+      createDirectoryIfMissing True (takeDirectory backupPath)+      renameFile oldPath backupPath  writeTextAtomic :: FilePath -> Text -> IO () writeTextAtomic path contents = do@@ -261,10 +256,10 @@   when exists (removeFile temporary)  renderSidecarMove :: SidecarMove -> Text-renderSidecarMove move = case sidecarMoveDisposition move of-  RenameSidecar -> path (sidecarOldPath move) <> " -> " <> path (sidecarNewPath move)-  RetireLegacySidecar -> path (sidecarOldPath move) <> " -> retired to " <> backup-  ConvertLegacyConformanceLedger -> path (sidecarOldPath move) <> " -> " <> path (sidecarNewPath move) <> "; original retired to " <> backup+renderSidecarMove move = case (.moveDisposition) move of+  RenameSidecar -> path ((.oldPath) move) <> " -> " <> path ((.newPath) move)+  RetireLegacySidecar -> path ((.oldPath) move) <> " -> retired to " <> backup+  ConvertLegacyConformanceLedger -> path ((.oldPath) move) <> " -> " <> path ((.newPath) move) <> "; original retired to " <> backup   where     path = T.pack-    backup = maybe "<missing-backup>" path (sidecarBackupPath move)+    backup = maybe "<missing-backup>" path ((.backupPath) move)

src/Keiro/Dsl/Source.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE NoFieldSelectors #-}- -- | Source locations used by the Keiro language frontend. -- -- Offsets count tokens in the parsed 'Text' stream. Spans are half-open: the

src/Keiro/Dsl/SourceIndex.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE NoFieldSelectors #-}- -- | Exact source provenance for semantic aggregate subjects. -- -- The index deliberately lives beside 'Keiro.Dsl.Grammar.Spec'. Source@@ -71,8 +69,8 @@  -- | The semantic parse result and its independently comparable source index. data ParsedSourceDocument = ParsedSourceDocument-  { documentParsedSource :: !ParsedSource,-    documentSourceIndex :: !SemanticSourceIndex+  { parsedSource :: !ParsedSource,+    sourceIndex :: !SemanticSourceIndex   }   deriving stock (Eq, Show, Generic) @@ -84,10 +82,10 @@   deriving stock (Eq, Ord, Show, Generic)  data SourceIndexFailure = SourceIndexFailure-  { failureCode :: !SourceIndexFailureCode,-    failureSubject :: !(Maybe SourceSubject),-    failureSpan :: !(Maybe SourceSpan),-    failureMessage :: !Text+  { code :: !SourceIndexFailureCode,+    subject :: !(Maybe SourceSubject),+    span :: !(Maybe SourceSpan),+    message :: !Text   }   deriving stock (Eq, Show, Generic) @@ -96,13 +94,13 @@ semanticSourceSubjects :: Spec -> [SourceSubject] semanticSourceSubjects spec = concatMap aggregateSubjects aggregates   where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]     aggregateSubjects aggregate =-      [ AggregateStateSubject (aggName aggregate) (stName state)-      | state <- aggStates aggregate+      [ AggregateStateSubject ((.name) aggregate) ((.name) state)+      | state <- (.states) aggregate       ]-        <> [ AggregateTransitionSubject (aggName aggregate) (TransitionOrdinal ordinal)-           | (ordinal, _) <- zip [0 ..] (aggTransitions aggregate)+        <> [ AggregateTransitionSubject ((.name) aggregate) (TransitionOrdinal ordinal)+           | (ordinal, _) <- zip [0 ..] ((.transitions) aggregate)            ]  -- | Construct a complete exact index for one parsed file. The expected@@ -118,10 +116,10 @@     Just (subject, sourceSpan) ->       Left         SourceIndexFailure-          { failureCode = SourceIndexFileMismatch,-            failureSubject = Just subject,-            failureSpan = Just sourceSpan,-            failureMessage = "source-index span belongs to a different source file"+          { code = SourceIndexFileMismatch,+            subject = Just subject,+            span = Just sourceSpan,+            message = "source-index span belongs to a different source file"           }     Nothing -> pure ()   checkedIndex ExactSourcePosition expected entries@@ -135,13 +133,13 @@   checkedIndex CompatibilityLineOnly expected entries   where     expected = semanticSourceSubjects spec-    entries = concatMap aggregateEntries [aggregate | NAggregate aggregate <- specNodes spec]+    entries = concatMap aggregateEntries [aggregate | NAggregate aggregate <- (.nodes) spec]     aggregateEntries aggregate =-      [ (AggregateStateSubject (aggName aggregate) (stName state), lineSpan (stLoc state))-      | state <- aggStates aggregate+      [ (AggregateStateSubject ((.name) aggregate) ((.name) state), lineSpan ((.loc) state))+      | state <- (.states) aggregate       ]-        <> [ (AggregateTransitionSubject (aggName aggregate) (TransitionOrdinal ordinal), lineSpan (tLoc transition))-           | (ordinal, transition) <- zip [0 ..] (aggTransitions aggregate)+        <> [ (AggregateTransitionSubject ((.name) aggregate) (TransitionOrdinal ordinal), lineSpan ((.loc) transition))+           | (ordinal, transition) <- zip [0 ..] ((.transitions) aggregate)            ]     lineSpan (Loc lineNumber) =       SourceSpan@@ -165,10 +163,10 @@     Just (subject, position) ->       Left         SourceIndexFailure-          { failureCode = SourceIndexFileMismatch,-            failureSubject = Just subject,-            failureSpan = Just (spanOf position),-            failureMessage = "source-index span does not match the workspace member source path"+          { code = SourceIndexFileMismatch,+            subject = Just subject,+            span = Just (spanOf position),+            message = "source-index span does not match the workspace member source path"           }     Nothing ->       Right@@ -178,8 +176,11 @@   where     spanOf IndexedSourcePosition {span = sourceSpan} = sourceSpan     sourceOf SourceSpan {source} = source-    replaceSource position@IndexedSourcePosition {span = sourceSpan} =-      position {span = sourceSpan {source = replacement}}+    replaceSource IndexedSourcePosition {quality, span = SourceSpan {start, end}} =+      IndexedSourcePosition+        { quality,+          span = SourceSpan {source = replacement, start, end}+        }  -- | Union complete member indices, refusing any duplicate semantic subject. unionSemanticSourceIndexes :: [SemanticSourceIndex] -> Either SourceIndexFailure SemanticSourceIndex@@ -217,20 +218,20 @@     Just subject ->       Left         SourceIndexFailure-          { failureCode = UnexpectedSourceSubject,-            failureSubject = Just subject,-            failureSpan = snd <$> find ((== subject) . fst) entries,-            failureMessage = "source index contains a subject absent from the semantic graph"+          { code = UnexpectedSourceSubject,+            subject = Just subject,+            span = snd <$> find ((== subject) . fst) entries,+            message = "source index contains a subject absent from the semantic graph"           }     Nothing -> pure ()   case Set.lookupMin (expectedSubjects Set.\\ actualSubjects) of     Just subject ->       Left         SourceIndexFailure-          { failureCode = MissingSourceSubject,-            failureSubject = Just subject,-            failureSpan = Nothing,-            failureMessage = "semantic graph subject has no source-index entry"+          { code = MissingSourceSubject,+            subject = Just subject,+            span = Nothing,+            message = "semantic graph subject has no source-index entry"           }     Nothing -> Right index @@ -242,10 +243,10 @@     Just duplicate ->       Left         SourceIndexFailure-          { failureCode = DuplicateSourceSubject,-            failureSubject = Just duplicate,-            failureSpan = spanOf <$> find ((== duplicate) . fst) entries,-            failureMessage = "source index contains more than one entry for a semantic subject"+          { code = DuplicateSourceSubject,+            subject = Just duplicate,+            span = spanOf <$> find ((== duplicate) . fst) entries,+            message = "source index contains more than one entry for a semantic subject"           }     Nothing -> Right (SemanticSourceIndex (Map.fromList entries))   where

src/Keiro/Dsl/StructuralConformance.hs view

@@ -58,7 +58,7 @@     Left failures -> Left [StructuralConformanceGraphFailure (T.pack (show failures))]     Right resolved -> Right resolved   let inventory = serviceMappedInventory (semanticImpact graph)-      missing = [key | key <- inventory, Map.notMember key (tgDeclarations graph)]+      missing = [key | key <- inventory, Map.notMember key ((.declarations) graph)]   case missing of     key : keys -> Left (map StructuralConformanceInventoryMissing (key : keys))     [] -> case inventory of@@ -68,39 +68,39 @@             moduleName = structuralConformanceModuleName ctx          in Right . Just $               ScaffoldModule-                { modulePath = T.unpack (T.replace "." "/" moduleName <> ".hs"),-                  moduleText = renderStructuralConformance rendering,+                { path = T.unpack (T.replace "." "/" moduleName <> ".hs"),+                  text = renderStructuralConformance rendering,                   kind = Generated,-                  origin = "context " <> specContext (checkedSpec service) <> " structural conformance"+                  origin = "context " <> (.context) (checkedSpec service) <> " structural conformance"                 }  data ConformanceRendering = ConformanceRendering-  { renderingContext :: !Context,-    renderingGraph :: !TypeGraph,-    renderingDeclarations :: ![ResolvedMappedDecl],-    renderingProjections :: ![StructuralProjection],-    renderingImportPlan :: !HaskellImportPlan+  { context :: !Context,+    graph :: !TypeGraph,+    declarations :: ![ResolvedMappedDecl],+    projections :: ![StructuralProjection],+    importPlan :: !HaskellImportPlan   }  conformanceRendering :: Context -> TypeGraph -> [MappedKey] -> ConformanceRendering conformanceRendering ctx graph inventory = rendering   where-    declarations = [declaration | key <- inventory, Just declaration <- [Map.lookup key (tgDeclarations graph)]]+    declarations = [declaration | key <- inventory, Just declaration <- [Map.lookup key ((.declarations) graph)]]     projections = map (resolveProjectionModules ctx) (projectionSpecs graph)     rendering =       ConformanceRendering-        { renderingContext = ctx,-          renderingGraph = graph,-          renderingDeclarations = declarations,-          renderingProjections = projections,-          renderingImportPlan = conformanceImportPlan ctx declarations projections+        { context = ctx,+          graph = graph,+          declarations = declarations,+          projections = projections,+          importPlan = conformanceImportPlan ctx declarations projections         }  renderStructuralConformance :: ConformanceRendering -> Text renderStructuralConformance rendering =   T.unlines $     [ generatedBanner,-      "module " <> structuralConformanceModuleName (renderingContext rendering),+      "module " <> structuralConformanceModuleName ((.context) rendering),       "  ( structuralConformanceAssertions",       "  ) where",       ""@@ -124,19 +124,19 @@       <> concatMap (coverageDecl rendering) structural       <> projectionAssertionDecls rendering structural   where-    structural = [(declaration, shape) | ResolvedStructural declaration shape <- renderingDeclarations rendering]-    opaque = [declaration | ResolvedOpaque declaration <- renderingDeclarations rendering]+    structural = [(declaration, shape) | ResolvedStructural declaration shape <- (.declarations) rendering]+    opaque = [declaration | ResolvedOpaque declaration <- (.declarations) rendering]     assertionLists =-      [lowerFirst (sdName declaration) <> "BindingAssertions" | (declaration, _) <- structural]-        <> [lowerFirst (odName declaration) <> "OpaqueAssertions" | declaration <- opaque]+      [lowerFirst ((.name) declaration) <> "BindingAssertions" | (declaration, _) <- structural]+        <> [lowerFirst ((.name) declaration) <> "OpaqueAssertions" | declaration <- opaque]         <> [ "[(\"fixture coverage: "-               <> unCanonicalTypeId (sdCanonical declaration)+               <> unCanonicalTypeId ((.canonical) declaration)                <> "\", coverage"-               <> sdName declaration+               <> (.name) declaration                <> ")]"            | (declaration, _) <- structural            ]-        <> ["structuralProjectionAssertions" | not (null (renderingProjections rendering))]+        <> ["structuralProjectionAssertions" | not (null ((.projections) rendering))]  conformanceImports :: ConformanceRendering -> [Text] conformanceImports rendering =@@ -148,27 +148,48 @@     <> ["import Keiki.Core (fieldWitnessAgrees)" | not (null projections)]     <> ["import Keiki.Shape (CanonicalTypeName (..))" | not (null structural)]     <> ["import Keiro.Codec.Structural (" <> T.intercalate ", " structuralCodecImports <> ")"]-    <> [ "import " <> structuralProjectionModuleName (renderingContext rendering) <> " qualified as StructuralProjections"+    <> [ "import " <> structuralProjectionModuleName ((.context) rendering) <> " qualified as StructuralProjections"        | not (null projections)        ]-    <> T.lines (renderPlannedImports (renderingImportPlan rendering))+    <> fieldScopeImports+    <> T.lines (renderPlannedImports ((.importPlan) rendering))   where-    declarations = renderingDeclarations rendering+    declarations = (.declarations) rendering     structural = [(declaration, shape) | ResolvedStructural declaration shape <- declarations]     opaque = [declaration | ResolvedOpaque declaration <- declarations]-    projections = renderingProjections rendering+    projections = (.projections) rendering+    fieldScopeImports =+      [ "import " <> shapeModule <> " (" <> lastSegment shapeModule <> "Shape(" <> T.intercalate ", " (Set.toAscList selectors) <> "))"+      | (shapeModule, selectors) <- Map.toAscList selectorsByModule+      ]+    selectorsByModule =+      Map.fromListWith+        Set.union+        ( [ (structuralShapeModuleName ((.context) rendering) ((.name) declaration), Set.singleton ((.haskell) field))+          | (declaration, RRecord _ _ fields) <- structural,+            field <- fields,+            isOptional ((.valueType) field)+          ]+            <> [ (shapeModule, Set.singleton selector)+               | projection <- projections,+                 (shapeModule, selector) <- (.selectors) projection+               ]+        )     structuralCodecImports =       ["FixtureCases (..)"]         <> if null structural then [] else ["bindingDomainRoundTrip", "bindingShapeRoundTrip", "bindingToShape"]     shapeUsesMaybe (_, shape) = case shape of-      RRecord _ _ fields -> any (isOptional . rwfType) fields-      RUnion _ arms -> any (maybe False isOptional . rwaPayload) arms+      RRecord _ _ fields -> any (isOptional . (.valueType)) fields+      RUnion _ arms -> any (maybe False isOptional . (.payload)) arms       REnum {} -> False     isOptional ROptional {} = True     isOptional _ = False +lastSegment :: Text -> Text+lastSegment = last . T.splitOn "."+ conformanceImportPlan :: Context -> [ResolvedMappedDecl] -> [StructuralProjection] -> HaskellImportPlan-conformanceImportPlan ctx declarations projections =+conformanceImportPlan ctx declarations _projections =   either     (error . ("validated structural conformance import planning failed: " <>) . show)     id@@ -187,9 +208,9 @@         | declaration <- declarations,           reference <- case declaration of             ResolvedStructural structural _ ->-              conformanceTypeReference (sdHaskell structural)-                : map conformanceQualifiedValueReference [sdBinding structural, sdFixtures structural]-            ResolvedOpaque opaque -> [conformanceQualifiedValueReference (odFixtures opaque)]+              conformanceTypeReference ((.haskell) structural)+                : map conformanceQualifiedValueReference [(.binding) structural, (.fixtures) structural]+            ResolvedOpaque opaque -> [conformanceQualifiedValueReference ((.fixtures) opaque)]         ]     shapeReferences =       Set.fromList@@ -197,17 +218,11 @@         | ResolvedStructural declaration shape <- declarations,           reference <- structuralShapeReferences ctx declaration shape         ]-    projectionReferences =-      Set.fromList-        [ HaskellReference shapeModule selector ValueNamespace RequireQualified-        | projection <- projections,-          (shapeModule, selector) <- spSelectors projection-        ]-    references = declarationReferences <> shapeReferences <> projectionReferences+    references = declarationReferences <> shapeReferences  conformanceTypeReference :: HaskellSource -> HaskellReference conformanceTypeReference source =-  HaskellReference (hsModule source) (hsType source) TypeNamespace PreferUnqualified+  HaskellReference ((.moduleName) source) ((.valueType) source) TypeNamespace PreferUnqualified  conformanceQualifiedValueReference :: QualifiedValueName -> HaskellReference conformanceQualifiedValueReference qualified =@@ -224,21 +239,20 @@ structuralShapeReferences ctx declaration =   foldMappedShape     MappedShapeAlgebra-      { onRecord = \constructor _ fields -> constructorRef constructor : map (valueRef . rwfHaskell) fields,-        onEnum = map (constructorRef . weCtor),-        onUnion = \_ -> map (constructorRef . rwaCtor)+      { onRecord = \_constructor _ _fields -> [],+        onEnum = map (constructorRef . (.ctor)),+        onUnion = \_ -> map (constructorRef . (.ctor))       }   where-    moduleName = structuralShapeModuleName ctx (sdName declaration)+    moduleName = structuralShapeModuleName ctx ((.name) declaration)     constructorRef constructor = HaskellReference moduleName constructor ConstructorNamespace RequireQualified-    valueRef value = HaskellReference moduleName value ValueNamespace RequireQualified  renderReference :: ConformanceRendering -> HaskellReference -> Text renderReference rendering reference =   either     (error . ("validated structural conformance reference failed: " <>) . show)     id-    (renderPlannedReference (renderingImportPlan rendering) reference)+    (renderPlannedReference ((.importPlan) rendering) reference)  bindingAssertionDecl :: ConformanceRendering -> (StructuralDecl, ResolvedMappedShape) -> [Text] bindingAssertionDecl rendering (declaration, _shape) =@@ -257,11 +271,11 @@     "    cases = fixtureCases " <> fixtures   ]   where-    valueName = lowerFirst (sdName declaration) <> "BindingAssertions"-    canonical = unCanonicalTypeId (sdCanonical declaration)-    consumerType = renderReference rendering (conformanceTypeReference (sdHaskell declaration))-    binding = renderReference rendering (conformanceQualifiedValueReference (sdBinding declaration))-    fixtures = renderReference rendering (conformanceQualifiedValueReference (sdFixtures declaration))+    valueName = lowerFirst ((.name) declaration) <> "BindingAssertions"+    canonical = unCanonicalTypeId ((.canonical) declaration)+    consumerType = renderReference rendering (conformanceTypeReference ((.haskell) declaration))+    binding = renderReference rendering (conformanceQualifiedValueReference ((.binding) declaration))+    fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration))  opaqueAssertionDecl :: ConformanceRendering -> OpaqueDecl -> [Text] opaqueAssertionDecl rendering declaration =@@ -276,15 +290,15 @@     "    cases = fixtureCases " <> fixtures   ]   where-    valueName = lowerFirst (odName declaration) <> "OpaqueAssertions"-    label = unCodecIdentity (odCodecIdentity declaration) <> "@" <> unCodecVersion (odCodecVersion declaration)-    fixtures = renderReference rendering (conformanceQualifiedValueReference (odFixtures declaration))+    valueName = lowerFirst ((.name) declaration) <> "OpaqueAssertions"+    label = unCodecIdentity ((.codecIdentity) declaration) <> "@" <> unCodecVersion ((.codecVersion) declaration)+    fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration))  coverageDecl :: ConformanceRendering -> (StructuralDecl, ResolvedMappedShape) -> [Text] coverageDecl rendering (declaration, shape) =   [ "",-    "coverage" <> sdName declaration <> " :: Bool",-    "coverage" <> sdName declaration <> " = " <> coverageExpression rendering declaration shape+    "coverage" <> (.name) declaration <> " :: Bool",+    "coverage" <> (.name) declaration <> " = " <> coverageExpression rendering declaration shape   ]  coverageExpression :: ConformanceRendering -> StructuralDecl -> ResolvedMappedShape -> Text@@ -292,34 +306,34 @@   [] -> "True"   _ -> T.intercalate " && " obligations <> "\n  where\n    shapes = map (bindingToShape " <> binding <> " . snd) (NonEmpty.toList (fixtureCases " <> fixtures <> "))"   where-    shapeModule = structuralShapeModuleName (renderingContext rendering) (sdName declaration)-    binding = renderReference rendering (conformanceQualifiedValueReference (sdBinding declaration))-    fixtures = renderReference rendering (conformanceQualifiedValueReference (sdFixtures declaration))+    shapeModule = structuralShapeModuleName ((.context) rendering) ((.name) declaration)+    binding = renderReference rendering (conformanceQualifiedValueReference ((.binding) declaration))+    fixtures = renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration))     obligations = case shape of       RRecord _ _ fields -> concatMap (recordFieldObligation rendering shapeModule) fields       REnum entries ->-        [ "any (\\case " <> renderReference rendering (HaskellReference shapeModule (weCtor entry) ConstructorNamespace RequireQualified) <> " -> True; _ -> False) shapes"+        [ "any (\\case " <> renderReference rendering (HaskellReference shapeModule ((.ctor) entry) ConstructorNamespace RequireQualified) <> " -> True; _ -> False) shapes"         | entry <- entries         ]       RUnion _ arms -> concatMap (unionArmObligations rendering shapeModule) arms  recordFieldObligation :: ConformanceRendering -> Text -> ResolvedWireField -> [Text]-recordFieldObligation rendering shapeModule field = case rwfType field of+recordFieldObligation _rendering _shapeModule field = case (.valueType) field of   ROptional _ ->     [ "any (isNothing . " <> selector <> ") shapes",       "any (isJust . " <> selector <> ") shapes"     ]   _ -> []   where-    selector = renderReference rendering (HaskellReference shapeModule (rwfHaskell field) ValueNamespace RequireQualified)+    selector = "(." <> (.haskell) field <> ")"  unionArmObligations :: ConformanceRendering -> Text -> ResolvedWireArm -> [Text] unionArmObligations rendering shapeModule arm =   ["any (\\case " <> patternText <> " -> True; _ -> False) shapes"] <> optionalPayload   where-    constructor = renderReference rendering (HaskellReference shapeModule (rwaCtor arm) ConstructorNamespace RequireQualified)-    patternText = constructor <> maybe "" (const "{}") (rwaPayload arm)-    optionalPayload = case rwaPayload arm of+    constructor = renderReference rendering (HaskellReference shapeModule ((.ctor) arm) ConstructorNamespace RequireQualified)+    patternText = constructor <> maybe "" (const "{}") ((.payload) arm)+    optionalPayload = case (.payload) arm of       Just (ROptional _) ->         [ "any (\\case " <> constructor <> " Nothing -> True; _ -> False) shapes",           "any (\\case " <> constructor <> " (Just _) -> True; _ -> False) shapes"@@ -337,52 +351,52 @@         "  ]"       ]   where-    specs = renderingProjections rendering+    specs = (.projections) rendering     assertion spec =       "(\"projection witness agreement: "-        <> unCanonicalTypeId (spCanonical spec)-        <> spPointer spec+        <> unCanonicalTypeId ((.canonical) spec)+        <> (.pointer) spec         <> "\", all (\\(_, owner) -> fieldWitnessAgrees StructuralProjections."-        <> spWitness spec+        <> (.witness) spec         <> " (\\referenceOwner -> "         <> projectionGetter rendering "referenceOwner" spec         <> ") owner) (NonEmpty.toList (fixtureCases "         <> ownerFixtures spec         <> ")))"-    ownerFixtures spec = case find (\(declaration, _) -> sdCanonical declaration == spCanonical spec) structural of-      Just (declaration, _) -> renderReference rendering (conformanceQualifiedValueReference (sdFixtures declaration))+    ownerFixtures spec = case find (\(declaration, _) -> (.canonical) declaration == (.canonical) spec) structural of+      Just (declaration, _) -> renderReference rendering (conformanceQualifiedValueReference ((.fixtures) declaration))       Nothing -> "error \"projection owner fixtures missing\""  projectionGetter :: ConformanceRendering -> Text -> StructuralProjection -> Text projectionGetter rendering owner spec =   foldl-    ( \value (shapeModule, selector) ->-        renderReference rendering (HaskellReference shapeModule selector ValueNamespace RequireQualified)-          <> " ("+    ( \value (_shapeModule, selector) ->+        "("           <> value-          <> ")"+          <> ")."+          <> selector     )-    ("bindingToShape " <> renderReference rendering (conformanceQualifiedValueReference (spBinding spec)) <> " " <> owner)-    (spSelectors spec)+    ("bindingToShape " <> renderReference rendering (conformanceQualifiedValueReference ((.binding) spec)) <> " " <> owner)+    ((.selectors) spec)  structuralShapeModuleName :: Context -> Name -> Text-structuralShapeModuleName ctx name = case placement ctx of+structuralShapeModuleName ctx name = case (.placement) ctx of   GeneratedPrefix -> root <> "Generated." <> contextSegment <> ".Structural.Shape." <> name   CollocatedLeaf -> root <> contextSegment <> ".Generated.Structural.Shape." <> name   where-    root = if T.null (moduleRoot ctx) then "" else moduleRoot ctx <> "."-    contextSegment = pascalFromKebab (contextName ctx)+    root = if T.null ((.moduleRoot) ctx) then "" else (.moduleRoot) ctx <> "."+    contextSegment = pascalFromKebab ((.name) ctx)  structuralProjectionModuleName :: Context -> Text structuralProjectionModuleName ctx = contextStructuralPrefix ctx <> ".StructuralProjections"  contextStructuralPrefix :: Context -> Text-contextStructuralPrefix ctx = case placement ctx of+contextStructuralPrefix ctx = case (.placement) ctx of   GeneratedPrefix -> root <> "Generated." <> contextSegment   CollocatedLeaf -> root <> contextSegment <> ".Generated"   where-    root = if T.null (moduleRoot ctx) then "" else moduleRoot ctx <> "."-    contextSegment = pascalFromKebab (contextName ctx)+    root = if T.null ((.moduleRoot) ctx) then "" else (.moduleRoot) ctx <> "."+    contextSegment = pascalFromKebab ((.name) ctx)  tshow :: (Show value) => value -> Text tshow = T.pack . show

src/Keiro/Dsl/Syntax.hs view

@@ -1,5 +1,3 @@-{-# LANGUAGE NoFieldSelectors #-}- -- | Located, non-lossless surface syntax for a Keiro source document. -- -- The surface layer preserves document order and source ownership while

src/Keiro/Dsl/TypeGraph.hs view

@@ -6,10 +6,15 @@ -- unrepresentable. module Keiro.Dsl.TypeGraph   ( QualifiedValueName (..),+    unQualifiedValueName,     CanonicalTypeId (..),+    unCanonicalTypeId,     BindingVersion (..),+    unBindingVersion,     CodecIdentity (..),+    unCodecIdentity,     CodecVersion (..),+    unCodecVersion,     mkQualifiedValueName,     mkCanonicalTypeId,     mkBindingVersion,@@ -21,6 +26,7 @@     OpaqueDecl (..),     checkMappedDecl,     MappedKey (..),+    unMappedKey,     ResolvedTypeExpr (..),     ResolvedWireField (..),     ResolvedWireArm (..),@@ -71,18 +77,33 @@ newtype QualifiedValueName = QualifiedValueName {unQualifiedValueName :: Text}   deriving stock (Eq, Ord, Show, Generic) +unQualifiedValueName :: QualifiedValueName -> Text+unQualifiedValueName (QualifiedValueName value) = value+ newtype CanonicalTypeId = CanonicalTypeId {unCanonicalTypeId :: Text}   deriving stock (Eq, Ord, Show, Generic) +unCanonicalTypeId :: CanonicalTypeId -> Text+unCanonicalTypeId (CanonicalTypeId value) = value+ newtype BindingVersion = BindingVersion {unBindingVersion :: Text}   deriving stock (Eq, Ord, Show, Generic) +unBindingVersion :: BindingVersion -> Text+unBindingVersion (BindingVersion value) = value+ newtype CodecIdentity = CodecIdentity {unCodecIdentity :: Text}   deriving stock (Eq, Ord, Show, Generic) +unCodecIdentity :: CodecIdentity -> Text+unCodecIdentity (CodecIdentity value) = value+ newtype CodecVersion = CodecVersion {unCodecVersion :: Text}   deriving stock (Eq, Ord, Show, Generic) +unCodecVersion :: CodecVersion -> Text+unCodecVersion (CodecVersion value) = value+ data MappedDeclError   = MissingHaskellSource !Name   | MissingStructuralBinding !Name@@ -124,25 +145,25 @@   | otherwise = Right (CodecVersion value)  data StructuralDecl = StructuralDecl-  { sdName :: !Name,-    sdHaskell :: !HaskellSource,-    sdBinding :: !QualifiedValueName,-    sdBindingVersion :: !BindingVersion,-    sdCanonical :: !CanonicalTypeId,-    sdFixtures :: !QualifiedValueName,-    sdInitial :: !(Maybe QualifiedValueName),-    sdLoc :: !Loc+  { name :: !Name,+    haskell :: !HaskellSource,+    binding :: !QualifiedValueName,+    bindingVersion :: !BindingVersion,+    canonical :: !CanonicalTypeId,+    fixtures :: !QualifiedValueName,+    initial :: !(Maybe QualifiedValueName),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  data OpaqueDecl = OpaqueDecl-  { odName :: !Name,-    odHaskell :: !HaskellSource,-    odCodecIdentity :: !CodecIdentity,-    odCodecVersion :: !CodecVersion,-    odFixtures :: !QualifiedValueName,-    odInitial :: !(Maybe QualifiedValueName),-    odLoc :: !Loc+  { name :: !Name,+    haskell :: !HaskellSource,+    codecIdentity :: !CodecIdentity,+    codecVersion :: !CodecVersion,+    fixtures :: !QualifiedValueName,+    initial :: !(Maybe QualifiedValueName),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -162,14 +183,14 @@   pure     ( CheckedStructural         StructuralDecl-          { sdName = name,-            sdHaskell = checkedHaskell,-            sdBinding = checkedBinding,-            sdBindingVersion = checkedBindingVersion,-            sdCanonical = checkedCanonical,-            sdFixtures = checkedFixtures,-            sdInitial = checkedInitial,-            sdLoc = loc+          { name = name,+            haskell = checkedHaskell,+            binding = checkedBinding,+            bindingVersion = checkedBindingVersion,+            canonical = checkedCanonical,+            fixtures = checkedFixtures,+            initial = checkedInitial,+            loc = loc           }         shape     )@@ -182,13 +203,13 @@   pure     ( CheckedOpaque         OpaqueDecl-          { odName = name,-            odHaskell = checkedHaskell,-            odCodecIdentity = checkedCodecIdentity,-            odCodecVersion = checkedCodecVersion,-            odFixtures = checkedFixtures,-            odInitial = checkedInitial,-            odLoc = loc+          { name = name,+            haskell = checkedHaskell,+            codecIdentity = checkedCodecIdentity,+            codecVersion = checkedCodecVersion,+            fixtures = checkedFixtures,+            initial = checkedInitial,+            loc = loc           }     ) @@ -201,6 +222,9 @@ newtype MappedKey = MappedKey {unMappedKey :: Name}   deriving stock (Eq, Ord, Show, Generic) +unMappedKey :: MappedKey -> Name+unMappedKey (MappedKey value) = value+ data ResolvedTypeExpr   = RText   | RInt@@ -216,20 +240,20 @@   deriving stock (Eq, Show, Generic)  data ResolvedWireField = ResolvedWireField-  { rwfHaskell :: !Name,-    rwfKey :: !Text,-    rwfType :: !ResolvedTypeExpr,-    rwfPresence :: !Presence,-    rwfOnMissing :: !(Maybe OnMissing),-    rwfLoc :: !Loc+  { haskell :: !Name,+    key :: !Text,+    valueType :: !ResolvedTypeExpr,+    presence :: !Presence,+    onMissing :: !(Maybe OnMissing),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic)  data ResolvedWireArm = ResolvedWireArm-  { rwaCtor :: !Name,-    rwaTag :: !Text,-    rwaPayload :: !(Maybe ResolvedTypeExpr),-    rwaLoc :: !Loc+  { ctor :: !Name,+    tag :: !Text,+    payload :: !(Maybe ResolvedTypeExpr),+    loc :: !Loc   }   deriving stock (Eq, Show, Generic) @@ -271,8 +295,8 @@   deriving stock (Eq, Ord, Show, Generic)  data UsePath = UsePath-  { upRoot :: !UseSite,-    upSegments :: ![PathSeg]+  { root :: !UseSite,+    segments :: ![PathSeg]   }   deriving stock (Eq, Ord, Show, Generic) @@ -292,20 +316,20 @@   deriving stock (Eq, Ord, Show, Generic)  data TypeGraph = TypeGraph-  { tgDeclarations :: !(Map MappedKey ResolvedMappedDecl),-    tgReachability :: !(Map MappedKey (Set MappedKey)),-    tgUseSites :: ![UseSite],-    tgRootSegments :: !(Map UseSite [PathSeg]),-    tgDerivedMappedConsumers :: ![DerivedMappedConsumer],-    tgReplayableProjectionGroups :: !(Map DerivedMappedConsumer Name),-    tgProjectionOperationalIdentities :: !(Map DerivedMappedConsumer Text),-    tgUnsupportedProjectionSources :: ![UnsupportedProjectionSource]+  { declarations :: !(Map MappedKey ResolvedMappedDecl),+    reachability :: !(Map MappedKey (Set MappedKey)),+    useSites :: ![UseSite],+    rootSegments :: !(Map UseSite [PathSeg]),+    derivedMappedConsumers :: ![DerivedMappedConsumer],+    replayableProjectionGroups :: !(Map DerivedMappedConsumer Name),+    projectionOperationalIdentities :: !(Map DerivedMappedConsumer Text),+    unsupportedProjectionSources :: ![UnsupportedProjectionSource]   }   deriving stock (Eq, Show, Generic)  resolveTypeGraph :: Spec -> Either (NonEmpty TypeGraphError) TypeGraph resolveTypeGraph spec = do-  checked <- collectChecked (specMapped spec)+  checked <- collectChecked ((.mapped) spec)   rejectMany (ambiguityErrors spec checked)   let keyByName = Map.fromList [(checkedName decl, MappedKey (checkedName decl)) | decl <- checked]       (resolveErrors, resolvedPairs) = partitionEithers (map (resolveCheckedDecl keyByName) checked)@@ -317,62 +341,62 @@   rejectMany rootErrors   pure     TypeGraph-      { tgDeclarations = declarations,-        tgReachability = reachability,-        tgUseSites = map fst (catMaybes rootSites),-        tgRootSegments = Map.fromList (catMaybes rootSites),-        tgDerivedMappedConsumers = sort (derivedMappedConsumers spec),-        tgReplayableProjectionGroups = replayableProjectionGroups spec,-        tgProjectionOperationalIdentities = projectionOperationalIdentities spec,-        tgUnsupportedProjectionSources = sort (unsupportedProjectionSources spec)+      { declarations = declarations,+        reachability = reachability,+        useSites = map fst (catMaybes rootSites),+        rootSegments = Map.fromList (catMaybes rootSites),+        derivedMappedConsumers = sort (derivedMappedConsumers spec),+        replayableProjectionGroups = replayableProjectionGroups spec,+        projectionOperationalIdentities = projectionOperationalIdentities spec,+        unsupportedProjectionSources = sort (unsupportedProjectionSources spec)       }  derivedMappedConsumers :: Spec -> [DerivedMappedConsumer] derivedMappedConsumers spec =-  [ AggregateInlineProjectionConsumer (aggName aggregate) (projTable projection)-  | NAggregate aggregate <- specNodes spec,-    Just projection <- [aggProjection aggregate]+  [ AggregateInlineProjectionConsumer ((.name) aggregate) ((.table) projection)+  | NAggregate aggregate <- (.nodes) spec,+    Just projection <- [(.projection) aggregate]   ]-    <> [ CatalogProjectionConsumer (poName owner) aggregate-       | NProjectionOwner owner <- specNodes spec,-         CatalogAggregate aggregate <- poSources owner+    <> [ CatalogProjectionConsumer ((.name) owner) aggregate+       | NProjectionOwner owner <- (.nodes) spec,+         CatalogAggregate aggregate <- (.sources) owner        ]  replayableProjectionGroups :: Spec -> Map DerivedMappedConsumer Name replayableProjectionGroups spec =   Map.fromList-    [ (CatalogProjectionConsumer (poName owner) aggregate, poGroup owner)-    | NProjectionOwner owner <- specNodes spec,-      poReplay owner == ProjectionReplayExplicit,-      CatalogAggregate aggregate <- poSources owner+    [ (CatalogProjectionConsumer ((.name) owner) aggregate, (.group) owner)+    | NProjectionOwner owner <- (.nodes) spec,+      (.replay) owner == ProjectionReplayExplicit,+      CatalogAggregate aggregate <- (.sources) owner     ]  projectionOperationalIdentities :: Spec -> Map DerivedMappedConsumer Text projectionOperationalIdentities spec =   Map.fromList (inlineRows <> catalogRows)   where-    readModels = [readModel | NReadModel readModel <- specNodes spec]+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]     inlineRows =-      [ ( AggregateInlineProjectionConsumer (aggName aggregate) (projTable projection),-          renderOperation Nothing [projTable projection] [rmName readModel | readModel <- readModels, rmName readModel == projTable projection] False+      [ ( AggregateInlineProjectionConsumer ((.name) aggregate) ((.table) projection),+          renderOperation Nothing [(.table) projection] [(.name) readModel | readModel <- readModels, (.name) readModel == (.table) projection] False         )-      | NAggregate aggregate <- specNodes spec,-        Just projection <- [aggProjection aggregate]+      | NAggregate aggregate <- (.nodes) spec,+        Just projection <- [(.projection) aggregate]       ]     catalogRows =-      [ ( CatalogProjectionConsumer (poName owner) aggregate,+      [ ( CatalogProjectionConsumer ((.name) owner) aggregate,           renderOperation-            (Just (poGroup owner))-            (poTargets owner)-            [ rmName readModel+            (Just ((.group) owner))+            ((.targets) owner)+            [ (.name) readModel             | readModel <- readModels,-              rmGroup readModel == Just (poGroup owner),-              not (Set.disjoint (Set.fromList (rmObservedTargets readModel)) (Set.fromList (poTargets owner)))+              (.group) readModel == Just ((.group) owner),+              not (Set.disjoint (Set.fromList ((.observedTargets) readModel)) (Set.fromList ((.targets) owner)))             ]-            (poReplay owner == ProjectionReplayExplicit)+            ((.replay) owner == ProjectionReplayExplicit)         )-      | NProjectionOwner owner <- specNodes spec,-        CatalogAggregate aggregate <- poSources owner+      | NProjectionOwner owner <- (.nodes) spec,+        CatalogAggregate aggregate <- (.sources) owner       ]     renderOperation groupName targets observers canReplay =       T.intercalate@@ -386,12 +410,12 @@ unsupportedProjectionSources :: Spec -> [UnsupportedProjectionSource] unsupportedProjectionSources spec =   [ boundary-  | NProjectionOwner owner <- specNodes spec,-    source <- poSources owner,+  | NProjectionOwner owner <- (.nodes) spec,+    source <- (.sources) owner,     boundary <- case source of       CatalogAggregate _ -> []-      CatalogCategory category -> [UnsupportedCatalogCategory (poName owner) category]-      CatalogAll -> [UnsupportedCatalogAll (poName owner)]+      CatalogCategory category -> [UnsupportedCatalogCategory ((.name) owner) category]+      CatalogAll -> [UnsupportedCatalogAll ((.name) owner)]   ]  collectChecked :: [MappedDecl] -> Either (NonEmpty TypeGraphError) [CheckedMappedDecl]@@ -414,8 +438,8 @@ rawName MappedOpaque {moName = name} = name  checkedName :: CheckedMappedDecl -> Name-checkedName (CheckedStructural declaration _) = sdName declaration-checkedName (CheckedOpaque declaration) = odName declaration+checkedName (CheckedStructural declaration _) = (.name) declaration+checkedName (CheckedOpaque declaration) = (.name) declaration  ambiguityErrors :: Spec -> [CheckedMappedDecl] -> [TypeGraphError] ambiguityErrors spec declarations =@@ -427,17 +451,17 @@     builtins = ["Text", "Int", "Bool", "Natural", "Time", "UTCTime", "Json", "Optional", "List", "Map"]     originPairs =       [(checkedName declaration, "mapped") | declaration <- declarations]-        ++ [(idName declaration, "id") | declaration <- specIds spec]-        ++ [(enumName declaration, "enum") | declaration <- specEnums spec]+        ++ [((.name) declaration, "id") | declaration <- (.ids) spec]+        ++ [((.name) declaration, "enum") | declaration <- (.enums) spec]         ++ [(name, "built-in") | name <- builtins]     allOrigins = Map.fromListWith (++) [(name, [origin]) | (name, origin) <- originPairs]  resolveCheckedDecl :: Map Name MappedKey -> CheckedMappedDecl -> Either TypeGraphError (MappedKey, ResolvedMappedDecl) resolveCheckedDecl _ (CheckedOpaque declaration) =-  Right (MappedKey (odName declaration), ResolvedOpaque declaration)+  Right (MappedKey ((.name) declaration), ResolvedOpaque declaration) resolveCheckedDecl keyByName (CheckedStructural declaration shape) = do-  resolvedShape <- resolveShape keyByName (sdName declaration) shape-  pure (MappedKey (sdName declaration), ResolvedStructural declaration resolvedShape)+  resolvedShape <- resolveShape keyByName ((.name) declaration) shape+  pure (MappedKey ((.name) declaration), ResolvedStructural declaration resolvedShape)  resolveShape :: Map Name MappedKey -> Name -> MappedShape -> Either TypeGraphError ResolvedMappedShape resolveShape keyByName owner (ShapeRecord constructor unknownFields fields) =@@ -445,11 +469,11 @@   where     resolveField field =       ResolvedWireField-        (wfHaskell field)-        (wfKey field)-        <$> resolveExpr keyByName owner (wireFieldLoc field) (wfType field)-        <*> pure (wfPresence field)-        <*> pure (wfOnMissing field)+        ((.haskell) field)+        ((.key) field)+        <$> resolveExpr keyByName owner (wireFieldLoc field) ((.valueType) field)+        <*> pure ((.presence) field)+        <*> pure ((.onMissing) field)         <*> pure (wireFieldLoc field) resolveShape _ _ (ShapeEnum entries) = Right (REnum entries) resolveShape keyByName owner (ShapeUnion encoding arms) =@@ -457,10 +481,10 @@   where     resolveArm arm =       ResolvedWireArm-        (waCtor arm)-        (waTag arm)-        <$> traverse (resolveExpr keyByName owner (waLoc arm)) (waPayload arm)-        <*> pure (waLoc arm)+        ((.ctor) arm)+        ((.tag) arm)+        <$> traverse (resolveExpr keyByName owner ((.loc) arm)) ((.payload) arm)+        <*> pure ((.loc) arm)  resolveExpr :: Map Name MappedKey -> Name -> Loc -> TypeExpr -> Either TypeGraphError ResolvedTypeExpr resolveExpr _ _ _ TText = Right RText@@ -482,7 +506,7 @@ resolveTypeExpression :: TypeGraph -> Text -> Loc -> TypeExpr -> Either TypeGraphError ResolvedTypeExpr resolveTypeExpression graph owner loc = resolveExpr keyByName owner loc   where-    keyByName = Map.fromList [(unMappedKey key, key) | key <- Map.keys (tgDeclarations graph)]+    keyByName = Map.fromList [(unMappedKey key, key) | key <- Map.keys ((.declarations) graph)]  cycleErrors :: Map MappedKey ResolvedMappedDecl -> [TypeGraphError] cycleErrors declarations =@@ -507,9 +531,9 @@ refsInShape =   foldMappedShape     MappedShapeAlgebra-      { onRecord = \_ _ fields -> Set.unions (map (refsInExpr . rwfType) fields),+      { onRecord = \_ _ fields -> Set.unions (map (refsInExpr . (.valueType)) fields),         onEnum = const Set.empty,-        onUnion = \_ arms -> Set.unions (map (maybe Set.empty refsInExpr . rwaPayload) arms)+        onUnion = \_ arms -> Set.unions (map (maybe Set.empty refsInExpr . (.payload)) arms)       }  refsInExpr :: ResolvedTypeExpr -> Set MappedKey@@ -545,47 +569,47 @@     <> concatMap workqueueSites workqueues     <> concatMap readModelSites readModels   where-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]-    workqueues = [workqueue | NWorkqueue workqueue <- specNodes spec]-    readModels = [readModel | NReadModel readModel <- specNodes spec]+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    workqueues = [workqueue | NWorkqueue workqueue <- (.nodes) spec]+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]     aggregateSites aggregate =-      [ (RootCommandField (aggName aggregate) (cmdName command) (aggregateFieldName field) key, [])-      | command <- aggCommands aggregate,-        field <- cmdFields command,-        key <- maybeToList (aggregateFieldType field >>= typeRefName >>= (`Map.lookup` keyByName))+      [ (RootCommandField ((.name) aggregate) ((.name) command) ((.name) field) key, [])+      | command <- (.commands) aggregate,+        field <- (.fields) command,+        key <- maybeToList ((.valueType) field >>= typeRefName >>= (`Map.lookup` keyByName))       ]-        ++ [ (RootEventField (aggName aggregate) (evName event) (aggregateFieldName field) key, [])-           | event <- aggEvents aggregate,+        ++ [ (RootEventField ((.name) aggregate) ((.name) event) ((.name) field) key, [])+           | event <- (.events) aggregate,              field <- eventFields aggregate event,-             key <- maybeToList (aggregateFieldType field >>= typeRefName >>= (`Map.lookup` keyByName))+             key <- maybeToList ((.valueType) field >>= typeRefName >>= (`Map.lookup` keyByName))            ]-        ++ [ (RootRegister (aggName aggregate) (regName register) key, [])-           | register <- aggRegs aggregate,-             key <- maybeToList (typeRefName (regType register) >>= (`Map.lookup` keyByName))+        ++ [ (RootRegister ((.name) aggregate) ((.name) register) key, [])+           | register <- (.regs) aggregate,+             key <- maybeToList (typeRefName ((.valueType) register) >>= (`Map.lookup` keyByName))            ]      workqueueSites workqueue =       [ consumerSite-          ("workqueue '" <> wqName workqueue <> "' payload field '" <> wqfName field <> "'")-          (wqfLoc field)-          (RootWorkqueueField (wqName workqueue) (wqfName field))+          ("workqueue '" <> (.name) workqueue <> "' payload field '" <> (.name) field <> "'")+          ((.loc) field)+          (RootWorkqueueField ((.name) workqueue) ((.name) field))           expression-      | field <- wqPayload workqueue,-        TypedQueueExpression expression <- [wqfType field]+      | field <- (.payload) workqueue,+        TypedQueueExpression expression <- [(.valueType) field]       ] -    readModelSites readModel = case queryTypes readModel of+    readModelSites readModel = case (.queryTypes) readModel of       Nothing -> []       Just ReadModelQueryTypes {input, result, inputLoc, resultLoc} ->         [ consumerSite-            ("readmodel '" <> rmName readModel <> "' query input")+            ("readmodel '" <> (.name) readModel <> "' query input")             inputLoc-            (RootReadModelQueryInput (rmName readModel))+            (RootReadModelQueryInput ((.name) readModel))             input,           consumerSite-            ("readmodel '" <> rmName readModel <> "' query result")+            ("readmodel '" <> (.name) readModel <> "' query result")             resultLoc-            (RootReadModelQueryResult (rmName readModel))+            (RootReadModelQueryResult ((.name) readModel))             result         ] @@ -611,21 +635,21 @@       RRef key -> Just (key, [])     prepend segment = fmap (\(key, segments) -> (key, segment : segments)) -    eventFields aggregate event = case evBody event of+    eventFields aggregate event = case (.body) event of       EventFields fields -> fields       EventFromCommand commandName ->-        concat [cmdFields command | command <- aggCommands aggregate, cmdName command == commandName]+        concat [(.fields) command | command <- (.commands) aggregate, (.name) command == commandName]      maybeToList = maybe [] pure     typeRefName (TRef name) = Just name     typeRefName _ = Nothing  usePaths :: TypeGraph -> Name -> [UsePath]-usePaths graph targetName = case Map.lookup (MappedKey targetName) (tgDeclarations graph) of+usePaths graph targetName = case Map.lookup (MappedKey targetName) ((.declarations) graph) of   Nothing -> []   Just _ ->     [ UsePath site segments-    | site <- tgUseSites graph,+    | site <- (.useSites) graph,       segments <- sitePaths site     ]   where@@ -638,7 +662,7 @@      pathsFromDecl visited current       | current `Set.member` visited = []-      | otherwise = case Map.lookup current (tgDeclarations graph) of+      | otherwise = case Map.lookup current ((.declarations) graph) of           Nothing -> []           Just declaration ->             foldMappedDecl@@ -653,13 +677,13 @@         MappedShapeAlgebra           { onRecord = \_ _ fields ->               concat-                [ map (SegField (rwfHaskell field) (rwfKey field) :) (pathsInExpr visited (rwfType field))+                [ map (SegField ((.haskell) field) ((.key) field) :) (pathsInExpr visited ((.valueType) field))                 | field <- fields                 ],             onEnum = const [],             onUnion = \_ arms ->               concat-                [ map (SegArm (rwaCtor arm) (rwaTag arm) :) (maybe [] (pathsInExpr visited) (rwaPayload arm))+                [ map (SegArm ((.ctor) arm) ((.tag) arm) :) (maybe [] (pathsInExpr visited) ((.payload) arm))                 | arm <- arms                 ]           }@@ -690,7 +714,7 @@ -- | Container path segments attached to a consumer root before its first -- mapped declaration reference. useSiteSegments :: TypeGraph -> UseSite -> [PathSeg]-useSiteSegments graph site = Map.findWithDefault [] site (tgRootSegments graph)+useSiteSegments graph site = Map.findWithDefault [] site ((.rootSegments) graph)  renderUsePath :: UsePath -> Text renderUsePath (UsePath root segments) = renderRoot root <> T.concat (map renderSegment segments)@@ -734,17 +758,17 @@  foldTypeExpr :: TypeExprAlgebra a -> ResolvedTypeExpr -> a foldTypeExpr algebra = \case-  RText -> onText algebra-  RInt -> onInt algebra-  RInteger -> onInteger algebra-  RBool -> onBool algebra-  RNatural -> onNatural algebra-  RTime -> onTime algebra-  RJson -> onJson algebra-  ROptional value -> onOptional algebra (foldTypeExpr algebra value)-  RList value -> onList algebra (foldTypeExpr algebra value)-  RMap value -> onMap algebra (foldTypeExpr algebra value)-  RRef key -> onRef algebra key+  RText -> (.onText) algebra+  RInt -> (.onInt) algebra+  RInteger -> (.onInteger) algebra+  RBool -> (.onBool) algebra+  RNatural -> (.onNatural) algebra+  RTime -> (.onTime) algebra+  RJson -> (.onJson) algebra+  ROptional value -> (.onOptional) algebra (foldTypeExpr algebra value)+  RList value -> (.onList) algebra (foldTypeExpr algebra value)+  RMap value -> (.onMap) algebra (foldTypeExpr algebra value)+  RRef key -> (.onRef) algebra key  data MappedShapeAlgebra a = MappedShapeAlgebra   { onRecord :: Name -> UnknownFields -> [ResolvedWireField] -> a,@@ -754,9 +778,9 @@  foldMappedShape :: MappedShapeAlgebra a -> ResolvedMappedShape -> a foldMappedShape algebra = \case-  RRecord constructor unknownFields fields -> onRecord algebra constructor unknownFields fields-  REnum entries -> onEnum algebra entries-  RUnion encoding arms -> onUnion algebra encoding arms+  RRecord constructor unknownFields fields -> (.onRecord) algebra constructor unknownFields fields+  REnum entries -> (.onEnum) algebra entries+  RUnion encoding arms -> (.onUnion) algebra encoding arms  data MappedDeclAlgebra a = MappedDeclAlgebra   { onStructuralDecl :: StructuralDecl -> ResolvedMappedShape -> a,@@ -765,13 +789,13 @@  foldMappedDecl :: MappedDeclAlgebra a -> ResolvedMappedDecl -> a foldMappedDecl algebra = \case-  ResolvedStructural declaration shape -> onStructuralDecl algebra declaration shape-  ResolvedOpaque declaration -> onOpaqueDecl algebra declaration+  ResolvedStructural declaration shape -> (.onStructuralDecl) algebra declaration shape+  ResolvedOpaque declaration -> (.onOpaqueDecl) algebra declaration  wireFingerprint :: TypeGraph -> Name -> Text wireFingerprint graph name = fnv1a64 (wireDecl Set.empty (MappedKey name))   where-    declarations = tgDeclarations graph+    declarations = (.declarations) graph      wireDecl visited key       | key `Set.member` visited = "recursive"@@ -782,7 +806,7 @@               MappedDeclAlgebra                 { onStructuralDecl = \_ shape -> wireShape (Set.insert key visited) shape,                   onOpaqueDecl = \opaque ->-                    "opaque(" <> atom (unCodecIdentity (odCodecIdentity opaque)) <> "," <> atom (unCodecVersion (odCodecVersion opaque)) <> ")"+                    "opaque(" <> atom (unCodecIdentity ((.codecIdentity) opaque)) <> "," <> atom (unCodecVersion ((.codecVersion) opaque)) <> ")"                 }               declaration @@ -790,31 +814,31 @@       foldMappedShape         MappedShapeAlgebra           { onRecord = \_ unknownFields fields ->-              "record(" <> renderUnknown unknownFields <> ";" <> T.intercalate ";" (map (wireField visited) (sortOn rwfKey fields)) <> ")",+              "record(" <> renderUnknown unknownFields <> ";" <> T.intercalate ";" (map (wireField visited) (sortOn (.key) fields)) <> ")",             onEnum = \entries ->-              "enum(" <> T.intercalate ";" (map (atom . weTag) (sortOn weTag entries)) <> ")",+              "enum(" <> T.intercalate ";" (map (atom . (.tag)) (sortOn (.tag) entries)) <> ")",             onUnion = \encoding arms ->               "union("-                <> atom (ueTagField encoding)+                <> atom ((.tagField) encoding)                 <> ","-                <> atom (ueContentsField encoding)+                <> atom ((.contentsField) encoding)                 <> ","-                <> renderUnknown (ueUnknownFields encoding)+                <> renderUnknown ((.unknownFields) encoding)                 <> ";"-                <> T.intercalate ";" (map (wireArm visited) (sortOn rwaTag arms))+                <> T.intercalate ";" (map (wireArm visited) (sortOn (.tag) arms))                 <> ")"           }      wireField visited field =-      atom (rwfKey field)+      atom ((.key) field)         <> ":"-        <> wireExpr visited (rwfType field)+        <> wireExpr visited ((.valueType) field)         <> ":"-        <> renderPresence (rwfPresence field)+        <> renderPresence ((.presence) field)         <> ":"-        <> maybe "none" (renderDefault field) (rwfOnMissing field)+        <> maybe "none" (renderDefault field) ((.onMissing) field) -    wireArm visited arm = atom (rwaTag arm) <> maybe ":unit" ((":" <>) . wireExpr visited) (rwaPayload arm)+    wireArm visited arm = atom ((.tag) arm) <> maybe ":unit" ((":" <>) . wireExpr visited) ((.payload) arm)      wireExpr visited = \case       RText -> "text"@@ -830,10 +854,10 @@       RRef key -> wireDecl visited key      renderDefault field (OmCtor constructor) =-      case rwfType field of+      case (.valueType) field of         RRef key -> case Map.lookup key declarations of           Just (ResolvedStructural _ (REnum entries)) ->-            maybe ("ctor:" <> atom constructor) ("enum:" <>) (lookup constructor [(weCtor entry, atom (weTag entry)) | entry <- entries])+            maybe ("ctor:" <> atom constructor) ("enum:" <>) (lookup constructor [((.ctor) entry, atom ((.tag) entry)) | entry <- entries])           _ -> "ctor:" <> atom constructor         _ -> "ctor:" <> atom constructor     renderDefault _ value = T.pack (show value)

src/Keiro/Dsl/Validate.hs view

@@ -54,4789 +54,4789 @@ import Keiro.Dsl.ReadModelShape (deriveShapeHash) import Keiro.Dsl.RouterSelection qualified as RouterSelection import Keiro.Dsl.RuntimePackage (isCabalPackageName)-import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract, checkedLanguageContract, checkedProjectionSupplies, checkedSpec, checkedTypeGraph, effectiveRuntimeProfile, legacyCheckedService)-import Keiro.Dsl.TypeGraph-import Keiro.Integration.Event qualified as Event-import Numeric (showHex)-import Text.Read (readMaybe)--data Severity = Error | Warning-  deriving stock (Eq, Show)--diagnosticCodeText :: DiagnosticCode -> Text-diagnosticCodeText = T.pack . show--parseDiagnosticCode :: Text -> Maybe DiagnosticCode-parseDiagnosticCode raw =-  case [diagnosticCode | diagnosticCode <- [minBound .. maxBound], diagnosticCodeText diagnosticCode == raw] of-    diagnosticCode : _ -> Just diagnosticCode-    [] -> Nothing---- | A machine-checkable code per rule, so tests match on the code, not prose.-data DiagnosticCode-  = UndeclaredCommand-  | UndeclaredEvent-  | UndeclaredState-  | UnreachableState-  | TerminalHasOutgoing-  | GuardAtomOutOfScope-  | StatusMapNotTotal-  | ClockSampled-  | -- EP-2 (evolution). These codes are shared by single-spec validation and-    -- the cross-spec diff path, so the enum remains the single registry of-    -- evolution rules.-    EvtVersionMissingUpcaster-  | UpcasterChainGap-  | DeprecatedEventReplayHazard-  | EventRetirementInProgress-  | DeprecatedEventStillEmitted-  | WireSchemaVersionMismatch-  | EvtFieldAddedWithoutBump-  | EvtRemovedNotDeprecated-  | -- EP-3 (process manager + durable timer).-    ProcessFireAtNotInjected-  | ProcessDispatchIdSupplied-  | ProcessUnresolvedRef-  | ProcessBenignInversion-  | SagaCategoryIllegal-  | -- EP-4 (integration intake / inbox disposition).-    DispositionIncomplete-  | DispositionDuplicateRetry-  | DispositionPreviouslyFailedRetry-  | DispositionDecodeUnboundedRetry-  | -- EP-4 (integration coupling).-    EmitSkipMissing-  | EmitUnresolvedContract-  | PublisherUnresolvedEmit-  | IntakeUnresolvedContract-  | -- EP-5 (pgmq workqueue/dispatch).-    WqPhysicalDivergence-  | WqStoreFailureNotRetry-  | WqDecodeFailureNotDeadLetter-  | WqDlqWithoutCeiling-  | WqGroupKeyMissing-  | WqGroupKeyWithoutFifo-  | WqGroupKeyUnresolved-  | WqUnloggedDurability-  | WqPartitionSpecEmpty-  | SnapshotIntervalInvalid-  | SnapshotCodecFixtureInvalid-  | DispatchEnqueueUnresolved-  | -- EP-6 (workflow/operation).-    AwaitSignalMismatch-  | RunWorkflowUnresolved-  | WorkflowPatchDuplicate-  | WorkflowPatchIdInvalid-  | WorkflowContinueAsNewNotTerminal-  | -- Diff-only (cross-spec) decode and identity evolution rules.-    EvtFieldTypeChanged-  | EvtFieldRemovedSameVersion-  | EvtVersionDecreased-  | EnumCtorRemoved-  | EnumWireSpellingChanged-  | WireSpecChanged-  | ContractEventRemoved-  | ContractFieldChanged-  | ContractDiscriminatorChanged-  | ContractTopicChanged-  | ContractSchemaVersionDecreased-  | WqPayloadFieldChanged-  | ProcessInputChanged-  | WorkflowShapeChanged-  | WorkflowBodyChanged-  | WorkflowStableNameChanged-  | WorkflowPatchRemoved-  | WorkflowContinueSeedChanged-  | WqOrderingChanged-  | WqProvisionChanged-  | WqGroupKeyChanged-  | IdPrefixChanged-  | DedupeIdentityChanged-  | DerivedIdentityChanged-  | QueueIdentityChanged-  | TimerWindowChanged-  | EmitMappingChanged-  | DecodePostureChanged-  | IntakePersistenceChanged-  | ProjectionChanged-  | PublisherPolicyChanged-  | DispatchRetargeted-  | ContractSchemaVersionBumped-  | EventUndeprecated-  | -- EP-104 (validator soundness).-    WorkflowDuplicateLabel-  | WorkflowSleepDelayUnresolved-  | WorkflowIdFieldUnresolved-  | RuleDomainUnresolved-  | RuleNotTotal-  | RuleCaseUnknownCtor-  | ProcessFieldBindingUnresolved-  | ProcessTimerCeilingInvalid-  | OperationUnresolvedRef-  | AwaitSignalValueMismatch-  | WqDispositionIncomplete-  | DispositionDuplicateOutcome-  | TopicAffinityMismatch-  | StatusMapDanglingKey-  | StatusMapDuplicateKey-  | WriteTargetNotRegister-  | RegisterInitialOutOfScope-  | DuplicateNodeName-  | DuplicateEnumCtor-  | DuplicateEnumWire-  | DuplicateIdPrefix-  | DuplicateCommandName-  | DuplicateEventName-  | WqDlqDivergence-  | WqTableDivergence-  | DispatchDedupQueueUnresolved-  | DispatchDedupFieldUnresolved-  | -- EP-105 (notation integrity and scaffold-safe names).-    VertexCtorCollision-  | IdentUnsafeNormalization-  | GeneratedOccurrenceReserved-  | GeneratedOccurrenceCollision-  | -- EP-107 (first-class read models).-    RmShapeHashDrift-  | RmStrongInlineOnly-  | RmScopeWithoutStrong-  | RmUnknownColumnType-  | RmInlineFeedUnreferenced-  | RmConsistencyConflict-  | RmProjectionWithoutNode-  | QueryUnresolvedReadModel-  | QueryConsistencyInvalid-  | DispatchReadModelUnresolved-  | DispatchReadModelFieldUnknown-  | -- MasterPlan 32 / EP-4 projection catalogs.-    CatalogTargetUnknown-  | CatalogGroupUnknown-  | CatalogGroupEmpty-  | CatalogGroupOrderMismatch-  | CatalogTargetUnowned-  | CatalogTargetMultiplyOwned-  | CatalogPhysicalTargetDuplicate-  | CatalogTargetDependencyUnknown-  | CatalogTargetDependencyOutsideGroup-  | CatalogTargetDependencyCycle-  | CatalogProjectionNoSource-  | CatalogProjectionNoTarget-  | CatalogProjectionTargetOutsideGroup-  | CatalogSourceUnresolved-  | CatalogSourceOverlap-  | CatalogAmbiguousSourceOrdering-  | CatalogAsyncIdentityMissing-  | CatalogAsyncQueryBindingMissing-  | CatalogInlineIdentityUnexpected-  | CatalogCheckpointPolicyMissing-  | CatalogCheckpointPolicyDuplicate-  | CatalogCheckpointPolicyUnexpected-  | CatalogCheckpointPolicyReplayUnsafe-  | CatalogClearTargetLiveOnly-  | CatalogDuplicateHandlerOrder-  | CatalogReadModelBindingMissing-  | CatalogReadModelTargetOutsideGroup-  | CatalogReadModelPhysicalOverride-  | CatalogReadModelBackingRequired-  | CatalogReadModelBackingUnobserved-  | CatalogReadModelSupplierMissing-  | CatalogReadModelMultipleSuppliers-  | CatalogReadModelLegacyProjectionConflict-  | CatalogQueryWaitWithoutCompatibleCursor-  | CatalogQueryWaitWithAmbiguousCursor-  | CatalogTargetAdded-  | CatalogTargetRemoved-  | CatalogTargetLocationChanged-  | CatalogTargetResetPolicyChanged-  | CatalogTargetDependencyChanged-  | CatalogGroupChanged-  | CatalogRevisionNoTarget-  | CatalogRevisionGroupUnknown-  | CatalogRevisionTargetUnknown-  | CatalogRevisionTargetSetMismatch-  | CatalogRevisionIdentityInvalid-  | CatalogRevisionDuplicateTarget-  | CatalogRevisionPromotionNameInvalid-  | CatalogProjectionRevisionChanged-  | CatalogProjectionRevisionRemoved-  | CatalogTargetSchemaChanged-  | CatalogExternalReadIdentityInvalid-  | CatalogExternalReadVersionInvalid-  | CatalogExternalReadQueryUnknown-  | CatalogExternalReadTargetCardinalityInvalid-  | CatalogExternalReadCompatibilityInvalid-  | CatalogExternalReadRevisionUnknown-  | CatalogExternalReadRevisionGroupMismatch-  | CatalogExternalReadSurfaceGenerationInvalid-  | CatalogExternalReadRetired-  | CatalogExternalReadVersionAdded-  | CatalogExternalReadCompatibilityChanged-  | CatalogExternalReadResultShapeChanged-  | CatalogExternalReadContractChanged-  | CatalogOwnerChanged-  | CatalogOwnerRemoved-  | CatalogHandlerOrderChanged-  | CatalogSourceChanged-  | CatalogFeedIdentityChanged-  | CatalogCheckpointPolicyChanged-  | CatalogReplayPolicyChanged-  | CatalogQueryBindingChanged-  | ProjectionDeliveryChanged-  | QueryFreshnessChanged-  | -- EP-107 diff-only read-model evolution rules.-    ReadModelVersionDecreased-  | ReadModelShapeChangedWithoutBump-  | ReadModelFeedChanged-  | ReadModelConsistencyWeakened-  | ReadModelQueryInputChanged-  | ReadModelQueryResultChanged-  | -- EP-108 (router and worker-policy surfaces).-    RouterUnresolvedRef-  | RouterKeyFieldUnknown-  | RouterBindingUnscoped-  | RouterCommandUnknown-  | RouterReadModelUnverified-  | PolicyContradiction-  | PolicyDeadLetterUnused-  | AmbiguousMarkedBenign-  | AmbiguousFollowsRejectedPolicy-  | RouterStableNameChanged-  | -- Plan 143 (first-class replay-only transitions for guard evolution).-    -- The first two fire in single-spec @validateSpec@; the third is the-    -- diff-path guard-tightening advisory that prints the computed-    -- replay-only twin.-    ReplayOnlyEmitsNothing-  | ReplayOnlyCommandStillLive-  | AggGuardTightened-  | AggFoldSurfaceChanged-  | RouterDecideSurfaceChanged-  | ProcessDecideSurfaceChanged-  | ProcessTimerPayloadChanged-  | -- MasterPlan 25 / EP-5: append-only codes for findings that were-    -- formerly additive but uncoded.-    DeclarationAdded-  | VersionBumped-  | CompatibilityStrengthened-  | EnumCtorAdded-  | EventRetirementAbandoned-  | ContractEventAdded-  | ContractTopicAdded-  | WorkflowEvolutionGuardAdded-  | -- MasterPlan 25 / EP-149 (consumer-owned mapped types).-    MappedUnresolvedName-  | MappedAmbiguousName-  | MappedDuplicateFieldName-  | MappedDuplicateWireKey-  | MappedDuplicateArmName-  | MappedDuplicateWireTag-  | MappedNonInjectiveNullability-  | MappedRecursiveType-  | MappedUnsupportedEncoding-  | MappedMissingIngredient-  | MappedMissingInitialValue-  | MappedInvalidHaskellName-  | MappedInvalidIdentity-  | MappedImportConflict-  | MappedDefaultIllTyped-  | -- MasterPlan 25 / EP-149 mapped evolution codes.-    MappedFieldAddedWithDefault-  | MappedFieldAddedNoDefault-  | MappedFieldRemoved-  | MappedFieldTypeChanged-  | MappedPresenceChanged-  | MappedNullabilityChanged-  | MappedDefaultRemoved-  | MappedDefaultChanged-  | MappedWireKeyChanged-  | MappedUnionEncodingChanged-  | MappedArmAdded-  | MappedArmRemoved-  | MappedArmTagChanged-  | MappedEnumValueAdded-  | MappedEnumValueRemoved-  | MappedEnumSpellingChanged-  | MappedHaskellSourceChanged-  | MappedRecordConstructorChanged-  | MappedBindingChanged-  | MappedFixturesChanged-  | MappedInitialChanged-  | MappedCanonicalTypeChanged-  | MappedOpaqueCodecChanged-  | MappedModeCrossed-  | MappedDeclAdded-  | MappedDeclRemoved-  | -- MasterPlan 25 / EP-152 reporting and migration-evidence codes.-    CoverageOpaqueSurface-  | CoverageOpaqueBoundaryAdded-  | CoverageOpaqueGateExceeded-  | CodecCompareDifference-  | CodecCompareCoverageGap-  | CodecCompareInvalidInput-  | -- MasterPlan 26 / EP-153: whole-service composition refusals, emitted by-    -- "Keiro.Dsl.Workspace" when several @.keiro@ members are composed into-    -- one service graph. They live in this registry, not a parallel enum, so-    -- every gate stays correlatable by code (ADR 0004). Manifest syntax and-    -- structure errors deliberately have no code here: like a @.keiro@ parse-    -- error, they are refused before any graph exists to diagnose.-    WorkspaceMemberUnreadable-  | WorkspaceMemberParseFailed-  | WorkspaceContextMismatch-  | WorkspaceAuthorityConflict-  | WorkspaceDuplicateDeclaration-  | WorkspaceDuplicateNodeName-  | WorkspacePathCollision-  | WorkspaceSourceIndexInvalid-  | -- MasterPlan 26 / EP-155: whole-workspace diff facts. These are-    -- advisory consumer-build obligations, distinct from wire evolution.-    OwnershipMoved-  | WorkspaceAuthorityChanged-  | -- EP-157: canonical aggregate type resolution and capabilities.-    AggregateTypeUnknown-  | AggregateTypeUnsupportedAtUse-  | AggregateRegisterInitialInvalid-  | AggregateGuardTypeMismatch-  | AggregateGuardCapabilityUnsupported-  | AggregateExpressionRootUnknown-  | AggregateExpressionRootAmbiguous-  | AggregateExpressionPathInvalid-  | AggregateExpressionPathUnsupported-  | AggregateExpressionLiteralNeedsType-  | AggregateExpressionLiteralInvalid-  | AggregateExpressionOperandTypeMismatch-  | AggregateExpressionOperatorUnsupported-  | AggregateExpressionBooleanRequired-  | AggregateExpressionGuardBoolRequired-  | AggregateExpressionWriteTargetUnknown-  | AggregateExpressionWriteTypeMismatch-  | AggregateTransitionOwnershipConflict-  | DomainOutcomeDeclarationMissing-  | DomainOutcomeDeclarationDuplicate-  | DomainOutcomeTypeUnresolved-  | DomainOutcomeClauseMissing-  | DomainOutcomeClauseDuplicate-  | DomainOutcomeReasonTypeMismatch-  | DomainOutcomeAcceptedWithoutEvents-  | DomainOutcomeSilentEmits-  | DomainOutcomeSilentWrites-  | DomainOutcomeSilentStateChange-  | DomainOutcomeReplayOnlyClause-  | DomainOutcomeTypesChanged-  | DomainTransitionOutcomeChanged-  | CollectionExpressionUnsupported-  | -- EP-160: append-only source-language composition and diff facts.-    WorkspaceLanguageVersionMismatch-  | SourceLanguageDeclarationChanged-  | -- EP-158: checked consumer-owned nominal IDs, enums, and scalars.-    NominalMissingIngredient-  | NominalInvalidHaskellSource-  | NominalInvalidQualifiedName-  | NominalInvalidIdentity-  | NominalInvalidIdPrefix-  | NominalUnsupportedRepresentation-  | NominalEmptyEnumRepresentation-  | NominalMissingInitialValue-  | NominalNameCollision-  | NominalBindingChanged-  | NominalFixturesChanged-  | NominalCanonicalTypeChanged-  | NominalInitialChanged-  | NominalRepresentationChanged-  | NominalIdDecoderTightened-  | -- ExecPlan 171 / IR-14: versioned prefix-bearing ID admission policy.-    IdDomainContractChanged-  | -- ExecPlan 159 / IR-13: @fields(Command)@ output authority.-    EventOutputCommandMismatch-  | AggregateEventlessStateChange-  | -- ExecPlan 178: language-4 integration contract TypeID admission.-    ContractInvalidTypeIdPrefix-  | ContractTypeIdDomainChanged-  | -- ExecPlan 180: accepted-but-unenforced spec surfaces.-    PublisherOrderingUnknown-  | PublisherBackoffInvalid-  | IntakeDedupePolicyUnknown-  | PublisherMaxAttemptsBelowMinimum-  | ContractSchemaVersionBelowMinimum-  | ReadModelVersionBelowMinimum-  | IntakeDecodeSchemaVersionBelowMinimum-  | AggregateDuplicateFieldName-  | ContractDuplicateFieldName-  | ContractFieldShadowsDiscriminator-  | TransitionDuplicateUnguarded-  | ContractDuplicateEvent-  | ContractDuplicateTopicAlias-  | AggregateDuplicateState-  | AggregateDuplicateRegister-  | NominalDuplicateDeclaration-  | EmitMapDuplicateCase-  | TransitionUnguardedSibling-  | RuntimeIdentityInvalid-  | RuntimeIdentityDuplicate-  | ContractTopicNameInvalid-  | ReadModelIdentifierInvalid-  | ReadModelDuplicateColumn-  | IntakeBindUnresolved-  | IntakeDedupeKeyUnresolved-  | IntakeEnvelopePolicyUnknown-  | IntakeDecodeSchemaVersionMismatch-  | ContractTopicAliasUnresolved-  | WireClauseUnsupported-  | -- ExecPlan 190: an unchanged semantic/external declaration now presents a-    -- different generated Haskell occurrence.-    GeneratedHaskellNameChanged-  | -- ExecPlan 192: resolved field wire identities are checked before lowering.-    FieldWireKeyCollision-  | FieldWireKeyInvalid-  | -- ExecPlan 192: changing an aggregate event field's resolved wire key-    -- changes the persisted event decode surface.-    EvtFieldWireKeyChanged-  | -- ExecPlan 193: a CI-required released language floor was not met.-    LanguageVersionBelowMinimum-  | -- ExecPlan 194: scaffold's empty-node refusals are reported by check at-    -- the owning declaration before planning begins.-    AggregateEmpty-  | ContractEmpty-  | -- ExecPlan 194: pure scaffold-planning gates share check's located,-    -- machine-readable diagnostic pipeline.-    GeneratedPathCollision-  | GeneratedImportCycle-  | BehaviorDerivationInvalid-  | BehaviorSourceAnchorMissing-  | BehaviorSourceAnchorInexact-  | BehaviorSourceAnchorCollision-  | ConformanceFactKeyCollision-  | GeneratedPlanningInvariantViolation-  | -- ExecPlan 197: accepted but currently inert spec surfaces are reported-    -- through the ordinary warning pipeline.-    IntakeBindFlagUnenforced-  | RmInlineSubscriptionIgnored-  | -- ExecPlan 197: process and router references close under language 4.-    ProcessKeyFieldUnknown-  | ProcessDispatchKeyUnresolved-  | ProcessBindingUnscoped-  | -- ExecPlan 197: remaining accepted surfaces close under language 4.-    WqPayloadTypeUnknown-  | WindowOutOfRange-  | TimerIdFieldNotCorrelation-  | AggProjectionKeyUnresolved-  | PublisherOutboxFieldUnresolved-  | RouterBenignInversion-  | -- ExecPlan 199: spellings the grammar accepts that no runtime implements.-    -- Each names one concrete runtime fact the declaration contradicts, warns on-    -- released languages below 4, and errors from language 4 on.-    DecodeBodyPostureUnsupported-  | DispatchOnAppendedUnsupported-  | TimerNotMineUnsupported-  | IntakeBindHeaderUnknown-  | -- ExecPlan 199: the surfaces ExecPlan 197 parked as descriptive-only, closed-    -- by checking the reference each one actually names.-    TimerDecodeStatusUnknown-  | TimerDeadLetterTextInvalid-  | PgmqFanoutFunctionInvalid-  | -- MasterPlan 35 / EP-1: candidate typed surfaces remain fail-closed until-    -- their complete lowering plans land.-    MappedQueueLoweringPending-  | MappedReadModelLoweringPending-  | RouterSelectionNotDeclarative-  | RouterSelectionCapabilityUnavailable-  | RouterSelectionIdentityEmpty-  | RouterSelectionVersionInvalid-  | RouterSelectionQueryUnknown-  | RouterSelectionQueryContractMissing-  | RouterSelectionQueryInputBindingInvalid-  | RouterSelectionQueryInputTypeMismatch-  | RouterSelectionQueryResultNotList-  | RouterSelectionQueryRowNotStructural-  | RouterSelectionExpressionRootUnknown-  | RouterSelectionExpressionFieldUnknown-  | RouterSelectionExpressionFieldOptional-  | RouterSelectionExpressionTypeMismatch-  | RouterSelectionPredicateNotBool-  | RouterSelectionRecipientNotText-  | RouterSelectionOperatorUnsupported-  | RouterSelectionRecipientLimitMissing-  | RouterSelectionRecipientLimitInvalid-  | RouterSelectionOrderUnsupported-  | RouterSelectionDedupeUnsupported-  | RouterSelectionFailureAckForbidden-  | RouterSelectionRedeliveryUnsupported-  | RouterSelectionPartialDispatchUnsupported-  | RouterSelectionTargetAmbiguous-  | RouterSelectionCommandUnknown-  | RouterSelectionCommandMappingDuplicate-  | RouterSelectionCommandMappingIncomplete-  | RouterSelectionCommandMappingTypeMismatch-  deriving stock (Eq, Ord, Show, Enum, Bounded)---- | Which command pipeline can actually produce a given 'DiagnosticCode'.------ The registry exists so a CI warning policy cannot silently name a code the--- selected command never emits. Before ExecPlan 199, @keiro-dsl check --deny--- EvtFieldWireKeyChanged@ was accepted and then matched nothing forever,--- because that code is only reachable from @diff@'s cross-revision comparison.-data DiagnosticOrigin-  = -- | Reachable from @check@ on a single spec or a workspace. This includes-    -- the pure scaffold-planning gates that @check@ replays, and it is the-    -- default for any code not positively classified below.-    CheckDiagnostic-  | -- | Reachable only from the structural-coverage pass, which runs only when-    -- @--coverage-report@ is supplied.-    CoverageDiagnostic-  | -- | Reachable only from @diff@, which compares two revisions of a spec.-    -- Nothing in a single-revision @check@ can produce these.-    DiffDiagnostic-  | -- | Reachable only from the generated codec-comparison path, which no-    -- @check@ or @diff@ invocation runs.-    CodecCompareDiagnostic-  deriving stock (Eq, Ord, Show, Enum, Bounded)---- | Classify a code by the pipeline that emits it.------ Only codes proven non-@check@ are listed; everything else falls through to--- 'CheckDiagnostic'. The default is deliberately the permissive one: a--- misclassification here would reject a working CI invocation, whereas falling--- through merely preserves the pre-199 behavior of accepting the code.-diagnosticOrigin :: DiagnosticCode -> DiagnosticOrigin-diagnosticOrigin diagnosticCode = case diagnosticCode of-  -- Structural coverage, reachable from `check --coverage-report`.-  CoverageOpaqueSurface -> CoverageDiagnostic-  CoverageOpaqueGateExceeded -> CoverageDiagnostic-  -- Coverage delta, computed only against a previous revision.-  CoverageOpaqueBoundaryAdded -> DiffDiagnostic-  -- Generated codec comparison.-  CodecCompareDifference -> CodecCompareDiagnostic-  CodecCompareCoverageGap -> CodecCompareDiagnostic-  CodecCompareInvalidInput -> CodecCompareDiagnostic-  -- Cross-revision evolution facts.-  AggFoldSurfaceChanged -> DiffDiagnostic-  AggGuardTightened -> DiffDiagnostic-  DomainOutcomeTypesChanged -> DiffDiagnostic-  DomainTransitionOutcomeChanged -> DiffDiagnostic-  CompatibilityStrengthened -> DiffDiagnostic-  ContractDiscriminatorChanged -> DiffDiagnostic-  ContractEventAdded -> DiffDiagnostic-  ContractEventRemoved -> DiffDiagnostic-  ContractFieldChanged -> DiffDiagnostic-  ContractSchemaVersionBumped -> DiffDiagnostic-  ContractSchemaVersionDecreased -> DiffDiagnostic-  ContractTopicAdded -> DiffDiagnostic-  ContractTopicChanged -> DiffDiagnostic-  ContractTypeIdDomainChanged -> DiffDiagnostic-  DeclarationAdded -> DiffDiagnostic-  DecodePostureChanged -> DiffDiagnostic-  DedupeIdentityChanged -> DiffDiagnostic-  DerivedIdentityChanged -> DiffDiagnostic-  DispatchRetargeted -> DiffDiagnostic-  EmitMappingChanged -> DiffDiagnostic-  EnumCtorAdded -> DiffDiagnostic-  EnumCtorRemoved -> DiffDiagnostic-  EnumWireSpellingChanged -> DiffDiagnostic-  EventRetirementAbandoned -> DiffDiagnostic-  EventUndeprecated -> DiffDiagnostic-  EvtFieldAddedWithoutBump -> DiffDiagnostic-  EvtFieldRemovedSameVersion -> DiffDiagnostic-  EvtFieldTypeChanged -> DiffDiagnostic-  EvtFieldWireKeyChanged -> DiffDiagnostic-  EvtRemovedNotDeprecated -> DiffDiagnostic-  EvtVersionDecreased -> DiffDiagnostic-  GeneratedHaskellNameChanged -> DiffDiagnostic-  IdDomainContractChanged -> DiffDiagnostic-  IdPrefixChanged -> DiffDiagnostic-  IntakePersistenceChanged -> DiffDiagnostic-  MappedArmAdded -> DiffDiagnostic-  MappedArmRemoved -> DiffDiagnostic-  MappedArmTagChanged -> DiffDiagnostic-  MappedBindingChanged -> DiffDiagnostic-  MappedCanonicalTypeChanged -> DiffDiagnostic-  MappedDeclAdded -> DiffDiagnostic-  MappedDeclRemoved -> DiffDiagnostic-  MappedDefaultChanged -> DiffDiagnostic-  MappedDefaultRemoved -> DiffDiagnostic-  MappedEnumSpellingChanged -> DiffDiagnostic-  MappedEnumValueAdded -> DiffDiagnostic-  MappedEnumValueRemoved -> DiffDiagnostic-  MappedFieldAddedNoDefault -> DiffDiagnostic-  MappedFieldAddedWithDefault -> DiffDiagnostic-  MappedFieldRemoved -> DiffDiagnostic-  MappedFieldTypeChanged -> DiffDiagnostic-  MappedFixturesChanged -> DiffDiagnostic-  MappedHaskellSourceChanged -> DiffDiagnostic-  MappedInitialChanged -> DiffDiagnostic-  MappedModeCrossed -> DiffDiagnostic-  MappedNullabilityChanged -> DiffDiagnostic-  MappedOpaqueCodecChanged -> DiffDiagnostic-  MappedPresenceChanged -> DiffDiagnostic-  MappedRecordConstructorChanged -> DiffDiagnostic-  MappedUnionEncodingChanged -> DiffDiagnostic-  MappedWireKeyChanged -> DiffDiagnostic-  NominalBindingChanged -> DiffDiagnostic-  NominalCanonicalTypeChanged -> DiffDiagnostic-  NominalFixturesChanged -> DiffDiagnostic-  NominalIdDecoderTightened -> DiffDiagnostic-  NominalInitialChanged -> DiffDiagnostic-  NominalRepresentationChanged -> DiffDiagnostic-  OwnershipMoved -> DiffDiagnostic-  ProcessDecideSurfaceChanged -> DiffDiagnostic-  ProcessInputChanged -> DiffDiagnostic-  ProcessTimerPayloadChanged -> DiffDiagnostic-  ProjectionChanged -> DiffDiagnostic-  PublisherPolicyChanged -> DiffDiagnostic-  QueueIdentityChanged -> DiffDiagnostic-  ReadModelConsistencyWeakened -> DiffDiagnostic-  ReadModelFeedChanged -> DiffDiagnostic-  ReadModelQueryInputChanged -> DiffDiagnostic-  ReadModelQueryResultChanged -> DiffDiagnostic-  ReadModelShapeChangedWithoutBump -> DiffDiagnostic-  ReadModelVersionDecreased -> DiffDiagnostic-  RouterDecideSurfaceChanged -> DiffDiagnostic-  RouterStableNameChanged -> DiffDiagnostic-  SourceLanguageDeclarationChanged -> DiffDiagnostic-  TimerWindowChanged -> DiffDiagnostic-  VersionBumped -> DiffDiagnostic-  WireSpecChanged -> DiffDiagnostic-  WorkflowBodyChanged -> DiffDiagnostic-  WorkflowContinueSeedChanged -> DiffDiagnostic-  WorkflowEvolutionGuardAdded -> DiffDiagnostic-  WorkflowPatchRemoved -> DiffDiagnostic-  WorkflowShapeChanged -> DiffDiagnostic-  WorkflowStableNameChanged -> DiffDiagnostic-  WorkspaceAuthorityChanged -> DiffDiagnostic-  WqGroupKeyChanged -> DiffDiagnostic-  WqOrderingChanged -> DiffDiagnostic-  WqPayloadFieldChanged -> DiffDiagnostic-  WqProvisionChanged -> DiffDiagnostic-  _ -> CheckDiagnostic---- | A line-numbered, structured diagnostic.-data Diagnostic = Diagnostic-  { line :: !Int,-    severity :: !Severity,-    code :: !DiagnosticCode,-    relatedLocations :: ![(Int, Text)],-    message :: !Text-  }-  deriving stock (Eq, Show)---- | Render a diagnostic in the conventional--- @\<file\>:\<line\>: error[\<code\>]: \<message\>@ form.-renderDiagnostic :: FilePath -> Diagnostic -> Text-renderDiagnostic file d =-  T.intercalate "\n" (primary : notes)-  where-    primary =-      T.pack file-        <> ":"-        <> T.pack (show (line d))-        <> ": "-        <> sev-        <> "["-        <> T.pack (show (code d))-        <> "]: "-        <> message d-    notes =-      [ "  " <> T.pack file <> ":" <> T.pack (show noteLine) <> ": note: " <> note-      | (noteLine, note) <- relatedLocations d-      ]-    sev = case severity d of Error -> "error"; Warning -> "warning"---- | Error diagnostics produced when the effective source language is below a--- CI-required released floor. A legacy source has no preamble, so line 1 is the--- actionable location where one should be added.-minimumLanguageDiagnostics :: LanguageVersion -> SourceLanguage -> [Diagnostic]-minimumLanguageDiagnostics floorVersion sourceLanguage-  | effectiveVersion >= floorVersion = []-  | otherwise =-      [ Diagnostic-          { line = sourceLanguageLine sourceLanguage,-            severity = Error,-            code = LanguageVersionBelowMinimum,-            relatedLocations = [],-            message =-              "effective language version "-                <> languageVersionText effectiveVersion-                <> " ("-                <> sourceFormText sourceLanguage-                <> ") is below the required minimum "-                <> languageVersionText floorVersion-                <> "; declare `language keiro-dsl "-                <> languageVersionText floorVersion-                <> "`"-          }-      ]-  where-    effectiveVersion = effectiveLanguageVersion sourceLanguage-    sourceLanguageLine LegacyUnversioned = 1-    sourceLanguageLine DeclaredLanguage {languageVersionLoc = Loc lineNumber} = lineNumber---- | Reserved wall-clock atom names. Sampling any of these inside a guard or--- write breaks deterministic replay: TIME IS INJECTED, NOT SAMPLED.-clockAtoms :: Set Name-clockAtoms = Set.fromList ["now", "currentTime", "wallClock", "today", "utcNow"]---- | Validate a whole service under its effective released semantic contract.--- An empty list means valid. Current released versions share this policy, but--- selecting it at this boundary prevents successor semantics from being lost.-validateService :: CheckedService -> [Diagnostic]-validateService service =-  validateCheckedSpec-    (checkedLanguageContract service)-    (checkedTypeGraph service)-    (checkedProjectionSupplies service)-    (checkedSpec service)---- | Compatibility wrapper for callers that have only a normalized graph. It--- explicitly selects legacy/version-1 semantics; production source/workspace--- routes use 'validateService'.-validateSpec :: Spec -> [Diagnostic]-validateSpec = validateService . legacyCheckedService--validateCheckedSpec :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> ProjectionSupplyAnalysis -> Spec -> [Diagnostic]-validateCheckedSpec languageContract typeGraphResult supplyAnalysis spec =-  sortOn line (validateNames languageContract typeGraphResult spec ++ validateMapped typeGraphResult spec ++ validateNominal languageContract spec ++ validateAggregateTypes typeGraphResult spec ++ specLevelRules languageContract supplyAnalysis spec ++ concatMap (validateNode languageContract typeGraphResult supplyAnalysis spec) (specNodes spec))---- | Rules added before language 4 ships consult the effective semantic--- contract, not the numeric source spelling. Versions 1 through 3 retain their--- released acceptance; runtime semantics 3 is the unreleased tightening gate.-enforcesSpecSurfaceClosures :: EffectiveLanguageContract -> Bool-enforcesSpecSurfaceClosures languageContract =-  runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) StrictSpecSurfaceValidation--hasProjectionCatalog :: EffectiveLanguageContract -> Bool-hasProjectionCatalog languageContract =-  runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) ProjectionCatalogRuntime--hasSeparatedProjectionQueryPolicy :: EffectiveLanguageContract -> Bool-hasSeparatedProjectionQueryPolicy languageContract =-  runtimeProfileHasCapability (effectiveRuntimeProfile languageContract) SeparatedProjectionQueryPolicy--validateNominal :: EffectiveLanguageContract -> Spec -> [Diagnostic]-validateNominal languageContract spec = domainErrors <> resolutionErrors-  where-    domainErrors =-      [ mkErr (locLine (idLoc declaration)) NominalInvalidIdPrefix $-          "id '" <> idName declaration <> "' has invalid TypeID prefix '" <> idPrefix declaration <> "': " <> T.pack (show reason)-      | declaration <- specIds spec,-        Just _ <- [idDomainContractFor languageContract (idPrefix declaration)],-        Just reason <- [TypeID.checkPrefix (idPrefix declaration)]-      ]-    resolutionErrors = case Nominal.resolveNominalTypes spec of-      Right _ -> []-      Left errors -> map nominalTypeDiagnostic (NE.toList errors)--nominalTypeDiagnostic :: Nominal.NominalTypeError -> Diagnostic-nominalTypeDiagnostic nominalError = case nominalError of-  Nominal.NominalMissingIngredient name loc ingredient ->-    problem loc NominalMissingIngredient $ "nominal declaration '" <> name <> "' is missing required " <> ingredient <> " provenance"-  Nominal.NominalInvalidHaskellSource name loc ingredient ->-    problem loc NominalInvalidHaskellSource $ "nominal declaration '" <> name <> "' has an invalid Haskell " <> ingredient <> " name"-  Nominal.NominalInvalidQualifiedValue name loc ingredient value ->-    problem loc NominalInvalidQualifiedName $-      "nominal declaration '" <> name <> "' has invalid " <> ingredient <> " symbol '" <> value <> "'; expected a module path plus a lower-initial value"-  Nominal.NominalInvalidIdentity name loc ingredient value ->-    problem loc NominalInvalidIdentity $ "nominal declaration '" <> name <> "' has invalid " <> ingredient <> " '" <> value <> "'"-  Nominal.NominalInvalidIdPrefix name loc prefix detail ->-    problem loc NominalInvalidIdPrefix $ "id '" <> name <> "' has invalid TypeID prefix '" <> prefix <> "': " <> detail-  Nominal.NominalUnsupportedScalar name loc representation ->-    problem loc NominalUnsupportedRepresentation $-      "nominal scalar '" <> name <> "' uses unsupported representation '" <> representation <> "'; supported representations are Text, Int, Natural, Bool, and Time"-  Nominal.NominalEmptyEnum name loc ->-    problem loc NominalEmptyEnumRepresentation $ "enum '" <> name <> "' must declare at least one closed representation constructor"-  Nominal.NominalMissingRegisterInitial name loc registerName ->-    problem loc NominalMissingInitialValue $-      "consumer-owned nominal type '" <> name <> "' is used by register '" <> registerName <> "' and must name an initial symbol"-  Nominal.NominalDeclarationCollision name loc categories ->-    problem loc NominalNameCollision $ "declaration name '" <> name <> "' collides across " <> T.intercalate ", " categories-  where-    problem loc diagnosticCode detail = mkErr (locLine loc) diagnosticCode (detail <> "; GHC and conformance validate consumer function bodies")---- | Resolve every direct aggregate type once at the earliest semantic gate.-validateAggregateTypes :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]-validateAggregateTypes typeGraphResult spec = case Nominal.resolveNominalTypes spec of-  Left _ -> []-  Right _ -> concatMap aggregateRules aggregates-  where-    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]--    aggregateRules aggregate =-      outcomeTypeRules aggregate-        ++ concatMap commandRules (aggCommands aggregate)-        ++ concatMap eventRules (aggEvents aggregate)-        ++ concatMap registerRules (aggRegs aggregate)-        ++ concatMap (transitionRules aggregate) (aggTransitions aggregate)-      where-        commandRules command = concatMap (fieldRule aggregate CommandFieldUse) (cmdFields command)-        eventRules event = case evBody event of-          EventFields fields -> concatMap (fieldRule aggregate EventFieldUse) fields-          EventFromCommand _ -> []-        registerRules register = case resolveAggregateType symbols (regLoc register) RegisterUse (regType register) of-          Left typeError -> [aggregateTypeDiagnostic typeError]-          Right AggregateMapped {} -> []-          Right resolved -> case resolveRegisterInitial symbols (regLoc register) resolved (regInitial register) of-            Left initialError -> [aggregateTypeDiagnostic initialError]-            Right _ -> []--    fieldRule aggregate useSite field =-      either (pure . aggregateTypeDiagnostic) (const []) (inferAggregateFieldType symbols aggregate useSite field)--    outcomeTypeRules aggregate = case aggDomainOutcomeTypes aggregate of-      Nothing -> []-      Just declaration ->-        unresolved "rejection" (rejectionType declaration)-          ++ unresolved "no-op" (noOpType declaration)-        where-          unresolved label name = case resolveAggregateType symbols (outcomeTypesLoc declaration) HaskellLoweringUse (TRef name) of-            Right _ -> []-            Left _ ->-              [ mkErr (locLine (outcomeTypesLoc declaration)) DomainOutcomeTypeUnresolved $-                  "aggregate '" <> aggName aggregate <> "' declares unknown or unsupported " <> label <> " outcome type '" <> name <> "'"-              ]--    transitionRules aggregate transition = ownershipRules ++ outcomeExpressionRules-      where-        environment = expressionEnvironmentFromGraphResult typeGraphResult spec aggregate transition-        ownershipRules = case tImplementation transition of-          LegacyHoleImplementation ->-            concatMap (comparisonRule aggregate transition) (maybe [] comparisons (tGuard transition))-          GeneratedImplementation ->-            maybe [] (expressionDiagnostics . resolveGuardExpr environment) (tGuard transition)-              ++ concatMap (expressionDiagnostics . uncurry (resolveWriteExpr environment)) (tWrites transition)-          HoleImplementation ->-            [ mkErr (locLine (tLoc transition)) AggregateTransitionOwnershipConflict $-                "transition '"-                  <> tSource transition-                  <> " -- "-                  <> tCommand transition-                  <> "' selects implementation hole and therefore cannot also declare guard or write clauses"-            | tGuard transition /= Nothing || not (null (tWrites transition))-            ]-        outcomeExpressionRules = case (aggDomainOutcomeTypes aggregate, tOutcome transition) of-          (Just declaration, Just (OutcomeRejected expression _)) -> resolveReason "rejected" (rejectionType declaration) expression-          (Just declaration, Just (OutcomeNoOp expression _)) -> resolveReason "no-op" (noOpType declaration) expression-          _ -> []-        resolveReason label typeName expression =-          case resolveAggregateType symbols (outcomeTypesLoc declaration) HaskellLoweringUse (TRef typeName) of-            Left _ -> []-            Right expected ->-              case resolveScalarExpr environment (ExpectScalarType expected) expression of-                Right _ -> []-                Left diagnostics -> map (outcomeExpressionDiagnostic label . id) (NE.toList diagnostics)-          where-            declaration = case aggDomainOutcomeTypes aggregate of-              Just value -> value-              Nothing -> error "unreachable: outcome reason without declaration"--    outcomeExpressionDiagnostic label diagnostic =-      mkErr-        (locLine (expressionDiagnosticLoc diagnostic))-        ( if expressionDiagnosticCode diagnostic `elem` [ScalarOperandTypeMismatch, ScalarBooleanOperandRequired]-            then DomainOutcomeReasonTypeMismatch-            else expressionCode (expressionDiagnosticCode diagnostic)-        )-        ("typed " <> label <> " outcome reason is invalid: " <> expressionDiagnosticMessage diagnostic)--    expressionDiagnostics = either (map expressionDiagnostic . NE.toList) (const [])--    expressionDiagnostic diagnostic =-      mkErr-        (locLine (expressionDiagnosticLoc diagnostic))-        (expressionCode (expressionDiagnosticCode diagnostic))-        (expressionDiagnosticMessage diagnostic)--    expressionCode = \case-      ScalarRootUnknown -> AggregateExpressionRootUnknown-      ScalarRootAmbiguous -> AggregateExpressionRootAmbiguous-      ScalarPathInvalid -> AggregateExpressionPathInvalid-      ScalarPathUnsupported -> AggregateExpressionPathUnsupported-      ScalarLiteralNeedsType -> AggregateExpressionLiteralNeedsType-      ScalarLiteralInvalid -> AggregateExpressionLiteralInvalid-      ScalarOperandTypeMismatch -> AggregateExpressionOperandTypeMismatch-      ScalarOperatorUnsupported -> AggregateExpressionOperatorUnsupported-      ScalarBooleanOperandRequired -> AggregateExpressionBooleanRequired-      ScalarGuardBoolRequired -> AggregateExpressionGuardBoolRequired-      ScalarWriteTargetUnknown -> AggregateExpressionWriteTargetUnknown-      ScalarWriteTypeMismatch -> AggregateExpressionWriteTypeMismatch--    comparisonRule aggregate transition (operator, left, right) =-      case (expressionType aggregate transition left, expressionType aggregate transition right) of-        (Right leftType, Right rightType)-          | leftType /= rightType ->-              [ mkErr (locLine (tLoc transition)) AggregateGuardTypeMismatch $-                  "comparison operands have different aggregate types '"-                    <> aggregateCanonicalName leftType-                    <> "' and '"-                    <> aggregateCanonicalName rightType-                    <> "'"-              ]-          | aggregateCapability useSite leftType == Unsupported ->-              [ mkErr (locLine (tLoc transition)) AggregateGuardCapabilityUnsupported $-                  renderAggregateUseSite useSite-                    <> " is unsupported for aggregate type '"-                    <> aggregateCanonicalName leftType-                    <> "'"-              ]-          | otherwise -> []-        _ -> []-      where-        useSite = case operator of-          OpEq -> EqualityGuardUse-          OpNeq -> EqualityGuardUse-          OpLt -> OrderingGuardUse-          OpLe -> OrderingGuardUse-          OpGt -> OrderingGuardUse-          OpGe -> OrderingGuardUse--    expressionType aggregate transition expression = case expression of-      EAtom (ABool _) -> pure AggregateBool-      EAtom (AName name) -> atomType aggregate transition name-      EOr {} -> pure AggregateBool-      EAnd {} -> pure AggregateBool-      ECmp {} -> pure AggregateBool-      EAdd _ left _ -> expressionType aggregate transition left-      ESubtract _ left _ -> expressionType aggregate transition left-      EMultiply _ left _ -> expressionType aggregate transition left-      EPath loc _ path -> case path of-        name : _ -> atomType aggregate transition name-        [] -> Left (AggregateTypeError loc EqualityGuardUse (UnknownAggregateType "<empty-path>"))-      ELiteral _ literal -> case literal of-        LiteralBool {} -> pure AggregateBool-        LiteralText {} -> pure AggregateText-        LiteralIntegral {} -> Left (AggregateTypeError (exprLoc expression) EqualityGuardUse (UnknownAggregateType "<contextual-integral-literal>"))-        LiteralQualified typeName _ -> resolveAggregateType symbols (exprLoc expression) EqualityGuardUse (TRef typeName)-        LiteralId typeName _ -> resolveAggregateType symbols (exprLoc expression) EqualityGuardUse (TRef typeName)--    atomType aggregate transition name = case [register | register <- aggRegs aggregate, regName register == name] of-      register : _ -> resolveAggregateType symbols (regLoc register) RegisterUse (regType register)-      [] -> case [field | command <- aggCommands aggregate, cmdName command == tCommand transition, field <- cmdFields command, aggregateFieldName field == name] of-        field : _ -> inferAggregateFieldType symbols aggregate CommandFieldUse field-        [] -> case [enumName declaration | declaration <- specEnums spec, name `elem` map fst (enumCtors declaration)] of-          enumType : _ -> resolveAggregateType symbols (tLoc transition) CommandFieldUse (TRef enumType)-          []-            | name `elem` map stName (aggStates aggregate) -> pure (AggregateVertex (aggName aggregate <> "Vertex"))-            | Just rule <- firstMatching ((== name) . ruleName) (specRules spec) ->-                resolveAggregateType symbols (ruleLoc rule) EqualityGuardUse (nameTypeExpr (ruleCodomain rule))-            | otherwise -> Left (AggregateTypeError (tLoc transition) EqualityGuardUse (UnknownAggregateType name))--    nameTypeExpr name = case name of-      "Text" -> TText-      "Int" -> TInt-      "Bool" -> TBool-      "Natural" -> TNatural-      "Time" -> TTime-      "UTCTime" -> TTime-      "Json" -> TJson-      _ -> TRef name--    comparisons expression = case expression of-      EOr left right -> comparisons left <> comparisons right-      EAnd left right -> comparisons left <> comparisons right-      ECmp operator left right -> (operator, left, right) : comparisons left <> comparisons right-      EAdd _ left right -> comparisons left <> comparisons right-      ESubtract _ left right -> comparisons left <> comparisons right-      EMultiply _ left right -> comparisons left <> comparisons right-      EPath {} -> []-      ELiteral {} -> []-      EAtom {} -> []--aggregateTypeDiagnostic :: AggregateTypeError -> Diagnostic-aggregateTypeDiagnostic aggregateError =-  mkErr (locLine (aggregateTypeErrorLoc aggregateError)) diagnosticCode diagnosticMessage-  where-    diagnosticCode = case aggregateTypeErrorReason aggregateError of-      UnknownAggregateType {} -> AggregateTypeUnknown-      UnsupportedAggregateShape {} -> AggregateTypeUnsupportedAtUse-      UnsupportedAggregateCapability {} -> case aggregateTypeErrorUseSite aggregateError of-        EqualityGuardUse -> AggregateGuardCapabilityUnsupported-        OrderingGuardUse -> AggregateGuardCapabilityUnsupported-        _ -> AggregateTypeUnsupportedAtUse-      InvalidRegisterInitial {} -> AggregateRegisterInitialInvalid-    diagnosticMessage = case aggregateTypeErrorReason aggregateError of-      UnknownAggregateType name ->-        "unknown aggregate type '" <> name <> "' at " <> renderAggregateUseSite (aggregateTypeErrorUseSite aggregateError)-      UnsupportedAggregateShape expression ->-        "direct aggregate type '"-          <> typeExprCanonicalName expression-          <> "' is unsupported at "-          <> renderAggregateUseSite (aggregateTypeErrorUseSite aggregateError)-          <> "; use a mapped structural declaration for Json or container shapes"-      UnsupportedAggregateCapability resolved ->-        renderAggregateUseSite (aggregateTypeErrorUseSite aggregateError)-          <> " is unsupported for aggregate type '"-          <> aggregateCanonicalName resolved-          <> "'"-      InvalidRegisterInitial resolved detail ->-        "invalid " <> aggregateCanonicalName resolved <> " register initial: " <> detail--renderAggregateUseSite :: AggregateUseSite -> Text-renderAggregateUseSite useSite = case useSite of-  CommandFieldUse -> "command field"-  EventFieldUse -> "event field"-  RegisterUse -> "register"-  EqualityGuardUse -> "equality guard"-  OrderingGuardUse -> "ordering guard"-  WholeValueWriteUse -> "whole-value write"-  CodecUse -> "JSON codec"-  SnapshotUse -> "snapshot"-  HarnessSampleUse -> "harness sample"-  HaskellLoweringUse -> "Haskell lowering"---- | Validate consumer-owned mapped declarations without inspecting consumer--- Haskell. Symbol-shaped facts are checked lexically here; GHC remains the--- authority for whether the named packages, modules, values, types, and--- instances actually exist with the promised types.-validateMapped :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]-validateMapped typeGraphResult spec =-  mappedLexicalRules spec-    ++ mappedIdentityRules spec-    ++ mappedConflictRules spec-    ++ case typeGraphResult of-      Left errors -> concatMap (typeGraphDiagnostic spec) (NE.toList errors)-      Right graph -> mappedGraphRules spec graph--typeGraphDiagnostic :: Spec -> TypeGraphError -> [Diagnostic]-typeGraphDiagnostic spec = \case-  TGDeclError name declarationError ->-    [ mkErr (mappedLine spec name) diagnosticCode $-        "mapped declaration '" <> name <> "': " <> declarationErrorMessage declarationError-    ]-    where-      diagnosticCode = case declarationError of-        MissingHaskellSource {} -> MappedMissingIngredient-        MissingStructuralBinding {} -> MappedMissingIngredient-        MissingStructuralBindingVersion {} -> MappedMissingIngredient-        MissingCanonicalType {} -> MappedMissingIngredient-        MissingFixtureCases {} -> MappedMissingIngredient-        MissingOpaqueCodecIdentity {} -> MappedMissingIngredient-        MissingOpaqueCodecVersion {} -> MappedMissingIngredient-        EmptyQualifiedValueName {} -> MappedInvalidHaskellName-        EmptyCanonicalTypeId {} -> MappedInvalidIdentity-        EmptyBindingVersion {} -> MappedInvalidIdentity-        EmptyCodecIdentity {} -> MappedInvalidIdentity-        EmptyCodecVersion {} -> MappedInvalidIdentity-  TGAmbiguousName name origins ->-    [ mkErr (mappedLine spec name) MappedAmbiguousName $-        "type name '" <> name <> "' is ambiguous across " <> T.intercalate ", " origins-    ]-  TGUnresolvedRef owner missing loc ->-    [ mkErr (locLine loc) MappedUnresolvedName $-        "mapped declaration '" <> owner <> "' references unresolved mapped type '" <> missing <> "'"-    ]-  TGUnresolvedConsumerRef owner missing loc ->-    [ mkErr (locLine loc) MappedUnresolvedName $-        owner <> " references unresolved mapped type '" <> missing <> "'"-    ]-  TGRecursive names ->-    [ mkErr (mappedLine spec (headOr "<mapped>" names)) MappedRecursiveType $-        "recursive structural mapping is unsupported: " <> T.intercalate " -> " (names <> take 1 names)-    ]--declarationErrorMessage :: MappedDeclError -> Text-declarationErrorMessage = \case-  MissingHaskellSource _ -> "missing complete haskell package/module/type ingredient"-  MissingStructuralBinding _ -> "missing binding ingredient; GHC will verify the named value and its type"-  MissingStructuralBindingVersion _ -> "missing binding-version ingredient"-  MissingCanonicalType _ -> "missing canonical-type ingredient"-  MissingFixtureCases _ -> "missing fixtures ingredient; GHC will verify the named FixtureCases value"-  MissingOpaqueCodecIdentity _ -> "missing opaque codec identity ingredient"-  MissingOpaqueCodecVersion _ -> "missing opaque codec version ingredient"-  EmptyQualifiedValueName _ -> "a binding, fixture, or initial symbol is empty; GHC will verify a syntactically valid qualified value"-  EmptyCanonicalTypeId _ -> "canonical-type must be non-empty"-  EmptyBindingVersion _ -> "binding-version must be non-empty"-  EmptyCodecIdentity _ -> "opaque codec identity must be non-empty"-  EmptyCodecVersion _ -> "opaque codec version must be non-empty"--mappedLine :: Spec -> Name -> Int-mappedLine spec name =-  maybe 1 (locLine . mappedLoc) (firstMatching ((== name) . mappedName) (specMapped spec))--mappedName :: MappedDecl -> Name-mappedName MappedStructural {msName = name} = name-mappedName MappedOpaque {moName = name} = name--mappedLoc :: MappedDecl -> Loc-mappedLoc MappedStructural {msLoc = loc} = loc-mappedLoc MappedOpaque {moLoc = loc} = loc--mappedHaskell :: MappedDecl -> Maybe HaskellSource-mappedHaskell MappedStructural {msHaskell = source} = source-mappedHaskell MappedOpaque {moHaskell = source} = source--mappedCanonical :: MappedDecl -> Maybe Text-mappedCanonical MappedStructural {msCanonical = canonical} = canonical-mappedCanonical MappedOpaque {} = Nothing--mappedLexicalRules :: Spec -> [Diagnostic]-mappedLexicalRules spec = concatMap declarationRules (specMapped spec)-  where-    declarationRules declaration =-      constructorRule "mapped declaration name" (mappedName declaration) declaration-        ++ maybe [] (haskellRules declaration) (mappedHaskell declaration)-        ++ qualifiedFacts declaration-        ++ shapeConstructorRules declaration--    haskellRules declaration source =-      [ invalid declaration $ "Haskell package '" <> hsPackage source <> "' does not follow Cabal package-name grammar"-      | not (isCabalPackageName (hsPackage source))-      ]-        ++ [ invalid declaration $ "Haskell module '" <> hsModule source <> "' must be dot-separated Upper identifiers"-           | not (moduleNameSafe (hsModule source))-           ]-        ++ [ invalid declaration $ "Haskell type '" <> hsType source <> "' must be an Upper identifier"-           | not (constructorSafe (hsType source))-           ]--    qualifiedFacts MappedStructural {msBinding = binding, msFixtures = fixtures, msInitial = initial, msLoc = loc} =-      concatMap (qualifiedRule loc) [("binding", binding), ("fixtures", fixtures), ("initial", initial)]-    qualifiedFacts MappedOpaque {moFixtures = fixtures, moInitial = initial, moLoc = loc} =-      concatMap (qualifiedRule loc) [("fixtures", fixtures), ("initial", initial)]--    qualifiedRule loc (category, value) = case value of-      Just symbol-        | not (T.null symbol) && not (qualifiedValueSafe symbol) ->-            [ mkErr (locLine loc) MappedInvalidHaskellName $-                category <> " symbol '" <> symbol <> "' must be a module path plus a lower-initial value; GHC will verify that it exists with the promised type"-            ]-      _ -> []--    shapeConstructorRules declaration = case declaration of-      MappedStructural {msShape = ShapeRecord constructor _ fields} ->-        constructorRule "record constructor" constructor declaration-          ++ [ invalidAt (wireFieldLoc field) $ "record selector '" <> wfHaskell field <> "' must be a lower-initial Haskell identifier"-             | field <- fields,-               not (lowerIdentifierSafe (wfHaskell field))-             ]-      MappedStructural {msShape = ShapeEnum entries} ->-        [ invalidAt (weLoc entry) $ "enum constructor '" <> weCtor entry <> "' must be an Upper identifier"-        | entry <- entries,-          not (constructorSafe (weCtor entry))-        ]-      MappedStructural {msShape = ShapeUnion _ arms} ->-        [ invalidAt (waLoc arm) $ "union constructor '" <> waCtor arm <> "' must be an Upper identifier"-        | arm <- arms,-          not (constructorSafe (waCtor arm))-        ]-      MappedOpaque {} -> []--    constructorRule category value declaration =-      [ invalid declaration $ category <> " '" <> value <> "' must be an Upper identifier"-      | not (constructorSafe value)-      ]-    invalid declaration detail = invalidAt (mappedLoc declaration) detail-    invalidAt loc detail =-      mkErr (locLine loc) MappedInvalidHaskellName (detail <> "; this is a syntax check only, and GHC will verify the consumer declaration")--mappedIdentityRules :: Spec -> [Diagnostic]-mappedIdentityRules spec =-  [ mkErr (locLine (mappedLoc declaration)) MappedInvalidIdentity $-      "mapped declaration '" <> mappedName declaration <> "' has an identity/version containing an ASCII control character"-  | declaration <- specMapped spec,-    value <- identityValues declaration,-    T.any asciiControl value-  ]-  where-    identityValues MappedStructural {msBindingVersion = bindingVersion, msCanonical = canonical} = present [bindingVersion, canonical]-    identityValues MappedOpaque {moCodecId = codecIdentity, moCodecVersion = codecVersion} = present [codecIdentity, codecVersion]-    present = foldr (maybe id (:)) []--mappedConflictRules :: Spec -> [Diagnostic]-mappedConflictRules spec = sourceCollisions ++ canonicalCollisions ++ packageCollisions-  where-    declarations = specMapped spec-    sourceFacts = [(declaration, source) | declaration <- declarations, source <- maybeToList (mappedHaskell declaration)]-    sourceCollisions =-      [ conflict declaration $-          "Haskell target '" <> hsModule source <> "." <> hsType source <> "' is claimed by more than one mapped declaration"-      | (declaration, source) <- duplicatesBy (\(_, value) -> (hsModule value, hsType value)) sourceFacts-      ]-    canonicalFacts = [(declaration, canonical) | declaration <- declarations, canonical <- maybeToList (mappedCanonical declaration), not (T.null canonical)]-    canonicalCollisions =-      [ conflict declaration $ "canonical-type '" <> canonical <> "' is claimed by more than one mapped declaration"-      | (declaration, canonical) <- duplicatesBy snd canonicalFacts-      ]-    moduleFacts = [(declaration, hsModule source, hsPackage source) | (declaration, source) <- sourceFacts]-    packageCollisions =-      [ conflict declaration $-          "Haskell module '" <> moduleName <> "' is declared from conflicting packages '" <> oldPackage <> "' and '" <> packageName <> "'"-      | (index, (declaration, moduleName, packageName)) <- zip [0 :: Int ..] moduleFacts,-        (_, oldModule, oldPackage) <- take index moduleFacts,-        oldModule == moduleName,-        oldPackage /= packageName-      ]-    conflict declaration detail = mkErr (locLine (mappedLoc declaration)) MappedImportConflict detail-    maybeToList = maybe [] pure--mappedGraphRules :: Spec -> TypeGraph -> [Diagnostic]-mappedGraphRules spec graph =-  concatMap declarationRules (Map.elems (tgDeclarations graph))-    ++ mappedRegisterInitialRules spec graph-  where-    declarationRules =-      foldMappedDecl-        MappedDeclAlgebra-          { onStructuralDecl = \declaration shape ->-              foldMappedShape (shapeRules declaration) shape,-            onOpaqueDecl = const []-          }--    shapeRules declaration =-      MappedShapeAlgebra-        { onRecord = \_ _ fields ->-            [ mappedError (rwfLoc field) MappedDuplicateFieldName declaration $-                "record selector '" <> rwfHaskell field <> "' is declared more than once"-            | field <- duplicatesBy rwfHaskell fields-            ]-              ++ [ mappedError (rwfLoc field) MappedDuplicateWireKey declaration $-                     "record wire key '" <> rwfKey field <> "' is declared more than once"-                 | field <- duplicatesBy rwfKey fields-                 ]-              ++ [ mappedError (rwfLoc field) MappedUnsupportedEncoding declaration "record wire keys must be non-empty"-                 | field <- fields,-                   T.null (rwfKey field)-                 ]-              ++ concatMap (fieldRules declaration) fields,-          onEnum = \entries ->-            [ mappedError (weLoc entry) MappedDuplicateArmName declaration $-                "enum constructor '" <> weCtor entry <> "' is declared more than once"-            | entry <- duplicatesBy weCtor entries-            ]-              ++ [ mappedError (weLoc entry) MappedDuplicateWireTag declaration $-                     "enum wire spelling '" <> weTag entry <> "' is declared more than once"-                 | entry <- duplicatesBy weTag entries-                 ]-              ++ [ mappedError (weLoc entry) MappedUnsupportedEncoding declaration "enum wire spellings must be non-empty"-                 | entry <- entries,-                   T.null (weTag entry)-                 ],-          onUnion = \encoding arms ->-            [ mappedError (sdLoc declaration) MappedUnsupportedEncoding declaration "tagged-object tag and contents keys must be distinct"-            | ueTagField encoding == ueContentsField encoding-            ]-              ++ [ mappedError (sdLoc declaration) MappedUnsupportedEncoding declaration "tagged-object tag and contents keys must be non-empty"-                 | T.null (ueTagField encoding) || T.null (ueContentsField encoding)-                 ]-              ++ [ mappedError (rwaLoc arm) MappedDuplicateArmName declaration $-                     "union constructor '" <> rwaCtor arm <> "' is declared more than once"-                 | arm <- duplicatesBy rwaCtor arms-                 ]-              ++ [ mappedError (rwaLoc arm) MappedDuplicateWireTag declaration $-                     "union wire tag '" <> rwaTag arm <> "' is declared more than once"-                 | arm <- duplicatesBy rwaTag arms-                 ]-              ++ [ mappedError (rwaLoc arm) MappedUnsupportedEncoding declaration "union wire tags must be non-empty"-                 | arm <- arms,-                   T.null (rwaTag arm)-                 ]-              ++ concatMap (armRules declaration) arms-        }--    fieldRules declaration field =-      defaultRules declaration field-        ++ [ mappedError (rwfLoc field) MappedNonInjectiveNullability declaration $-               "field '" <> rwfHaskell field <> "' contains Optional around a null-capable Json, Optional, or opaque mapped value"-           | hasNonInjectiveOptional graph (rwfType field)-           ]--    armRules declaration arm =-      [ mappedError (rwaLoc arm) MappedNonInjectiveNullability declaration $-          "union arm '" <> rwaCtor arm <> "' contains Optional around a null-capable Json, Optional, or opaque mapped value"-      | payload <- maybeToList (rwaPayload arm),-        hasNonInjectiveOptional graph payload-      ]--    defaultRules declaration field = case (rwfPresence field, rwfOnMissing field) of-      (PRequired, Just _) -> [illTyped "required fields cannot declare on-missing"]-      (POptional, Nothing) ->-        [ mappedError (rwfLoc field) MappedMissingIngredient declaration $-            "optional field '" <> rwfHaskell field <> "' is missing its on-missing policy"-        ]-      (POptional, Just value)-        | not (defaultMatches graph (rwfType field) value) -> [illTyped "on-missing value does not match the field type or numeric bounds"]-      _ -> []-      where-        illTyped detail =-          mappedError (rwfLoc field) MappedDefaultIllTyped declaration $-            "field '" <> rwfHaskell field <> "': " <> detail--    mappedError loc diagnosticCode declaration detail =-      mkErr (locLine loc) diagnosticCode $-        "mapped declaration '" <> sdName declaration <> "' " <> detail-    maybeToList = maybe [] pure--data DefaultType-  = DefaultText-  | DefaultInt-  | DefaultBool-  | DefaultNatural-  | DefaultOptional-  | DefaultList-  | DefaultMap-  | DefaultEnum !(Set Name)-  | DefaultOther--defaultMatches :: TypeGraph -> ResolvedTypeExpr -> OnMissing -> Bool-defaultMatches graph expression value = case (defaultType graph expression, value) of-  (DefaultText, OmText _) -> True-  (DefaultInt, OmInt integer) -> integer >= toInteger (minBound :: Int) && integer <= toInteger (maxBound :: Int)-  (DefaultBool, OmBool _) -> True-  (DefaultNatural, OmInt integer) -> integer >= 0-  (DefaultOptional, OmNull) -> True-  (DefaultList, OmEmptyList) -> True-  (DefaultMap, OmEmptyMap) -> True-  (DefaultEnum constructors, OmCtor constructor) -> constructor `Set.member` constructors-  _ -> False--defaultType :: TypeGraph -> ResolvedTypeExpr -> DefaultType-defaultType graph =-  foldTypeExpr-    TypeExprAlgebra-      { onText = DefaultText,-        onInt = DefaultInt,-        onInteger = DefaultInt,-        onBool = DefaultBool,-        onNatural = DefaultNatural,-        onTime = DefaultOther,-        onJson = DefaultOther,-        onOptional = const DefaultOptional,-        onList = const DefaultList,-        onMap = const DefaultMap,-        onRef = referencedDefaultType graph-      }--referencedDefaultType :: TypeGraph -> MappedKey -> DefaultType-referencedDefaultType graph key = case Map.lookup key (tgDeclarations graph) of-  Nothing -> DefaultOther-  Just declaration ->-    foldMappedDecl-      MappedDeclAlgebra-        { onStructuralDecl = \_ shape ->-            foldMappedShape-              MappedShapeAlgebra-                { onRecord = \_ _ _ -> DefaultOther,-                  onEnum = DefaultEnum . Set.fromList . map weCtor,-                  onUnion = \_ _ -> DefaultOther-                }-              shape,-          onOpaqueDecl = const DefaultOther-        }-      declaration--data NullabilityFacts = NullabilityFacts-  { nfTopNull :: !Bool,-    nfBadOptional :: !Bool-  }--hasNonInjectiveOptional :: TypeGraph -> ResolvedTypeExpr -> Bool-hasNonInjectiveOptional graph =-  nfBadOptional-    . foldTypeExpr-      TypeExprAlgebra-        { onText = nonNull,-          onInt = nonNull,-          onInteger = nonNull,-          onBool = nonNull,-          onNatural = nonNull,-          onTime = nonNull,-          onJson = nullable,-          onOptional = \child -> NullabilityFacts True (nfTopNull child || nfBadOptional child),-          onList = nestedNonNull,-          onMap = nestedNonNull,-          onRef = \key -> if mappedRefIsOpaque graph key then nullable else nonNull-        }-  where-    nonNull = NullabilityFacts False False-    nullable = NullabilityFacts True False-    nestedNonNull child = NullabilityFacts False (nfBadOptional child)--mappedRefIsOpaque :: TypeGraph -> MappedKey -> Bool-mappedRefIsOpaque graph key = case Map.lookup key (tgDeclarations graph) of-  Nothing -> False-  Just declaration ->-    foldMappedDecl-      MappedDeclAlgebra-        { onStructuralDecl = \_ _ -> False,-          onOpaqueDecl = const True-        }-      declaration--mappedRegisterInitialRules :: Spec -> TypeGraph -> [Diagnostic]-mappedRegisterInitialRules spec graph =-  concatMap aggregateRules [aggregate | NAggregate aggregate <- specNodes spec]-  where-    aggregateRules aggregate = concatMap registerRule (aggRegs aggregate)-    registerRule register = case regType register of-      TRef typeName -> case Map.lookup (MappedKey typeName) (tgDeclarations graph) of-        Nothing -> []-        Just declaration -> case regInitial register of-          RegInitBare "initial"-            | mappedInitial declaration == Nothing ->-                [ mkErr (locLine (regLoc register)) MappedMissingInitialValue $-                    "mapped register '" <> regName register <> "' requires declaration '" <> typeName <> "' to name an explicit initial value"-                ]-            | otherwise -> []-          _ ->-            [ mkErr (locLine (regLoc register)) RegisterInitialOutOfScope $-                "mapped register '" <> regName register <> "' must use the bare initial token; the declaration-owned symbol is verified by GHC"-            ]-      _ -> []-    mappedInitial =-      foldMappedDecl-        MappedDeclAlgebra-          { onStructuralDecl = \declaration _ -> sdInitial declaration,-            onOpaqueDecl = odInitial-          }--moduleNameSafe :: Text -> Bool-moduleNameSafe moduleName =-  not (null components) && all constructorSafe components-  where-    components = T.splitOn "." moduleName--qualifiedValueSafe :: Text -> Bool-qualifiedValueSafe qualified = case reverse (T.splitOn "." qualified) of-  value : reversedModule ->-    not (null reversedModule)-      && lowerIdentifierSafe value-      && all constructorSafe reversedModule-  [] -> False--lowerIdentifierSafe :: Text -> Bool-lowerIdentifierSafe name = case T.uncons name of-  Just (first, rest) -> asciiLower first && T.all asciiAlphaNumOrUnderscore rest && name `Set.notMember` HaskellName.haskellKeywords-  Nothing -> False--asciiControl :: Char -> Bool-asciiControl c = ord c < 32 || ord c == 127--firstMatching :: (a -> Bool) -> [a] -> Maybe a-firstMatching predicate = \case-  [] -> Nothing-  value : rest-    | predicate value -> Just value-    | otherwise -> firstMatching predicate rest--headOr :: a -> [a] -> a-headOr fallback = \case-  [] -> fallback-  value : _ -> value---- | Check every logical name before a renderer can turn it into Haskell.  The--- parser enforces the ASCII alphabet; 'HaskellName' owns word segmentation,--- casing, keywords, and normalized collision keys.-validateNames :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]-validateNames languageContract typeGraphResult spec =-  concat-    [ concatMap idNames (specIds spec),-      concatMap enumNames (specEnums spec),-      concatMap nominalNames (specNominalScalars spec),-      concatMap nodeNames (specNodes spec),-      normalizedCollisions-    ]-  where-    idNames declaration =-      constructorName "id name" (idName declaration) (idLoc declaration)--    enumNames declaration =-      constructorName "enum name" (enumName declaration) (enumLoc declaration)-        ++ concatMap-          (\(ctor, _) -> constructorName ("constructor of enum '" <> enumName declaration <> "'") ctor (enumLoc declaration))-          (enumCtors declaration)--    nominalNames declaration =-      constructorName "nominal scalar name" (nominalScalarName declaration) (nominalScalarLoc declaration)--    nodeNames = \case-      NAggregate aggregate -> aggregateNames aggregate-      NProcess process -> processNames process-      NRouter router -> routerNames router-      NContract contract ->-        pascalizedNodeName "contract" (ctrName contract) (ctrLoc contract)-          ++ concatMap-            (\event -> constructorName "contract event name" (ceName event) (ctrLoc contract) ++ concatMap contractFieldName (ceFields event))-            (ctrEvents contract)-      NIntake intake -> pascalizedNodeName "intake" (inkName intake) (inkLoc intake)-      NEmit emitNode -> pascalizedNodeName "emit" (emName emitNode) (emLoc emitNode)-      NPublisher publisher -> pascalizedNodeName "publisher" (pubName publisher) (pubLoc publisher)-      NWorkqueue workqueue ->-        pascalizedNodeName "workqueue" (wqName workqueue) (wqLoc workqueue)-          ++ constructorName "workqueue payload name" (wqPayloadName workqueue) (wqLoc workqueue)-          ++ concatMap (\field -> fieldNameRule "workqueue payload field" (wqfName field) (wqLoc workqueue)) (wqPayload workqueue)-      NPgmqDispatch dispatch -> pascalizedNodeName "dispatch" (pdName dispatch) (pdLoc dispatch)-      NReadModel readModel -> pascalizedNodeName "readmodel" (rmName readModel) (rmLoc readModel)-      NProjectionTarget target -> pascalizedNodeName "target" (ptName target) (ptLoc target)-      NRebuildGroup groupNode -> pascalizedNodeName "rebuild group" (rgName groupNode) (rgLoc groupNode)-      NProjectionRevision revision -> pascalizedNodeName "projection revision" (prvName revision) (prvLoc revision)-      NExternalRead externalRead -> pascalizedNodeName "external read" (externalReadNodeIdentity externalRead) (erLoc externalRead)-      NProjectionOwner owner -> pascalizedNodeName "projection owner" (poName owner) (poLoc owner)-      NWorkflow workflow -> workflowNames workflow-      NOperation _ -> []--    aggregateNames aggregate =-      constructorName "aggregate name" (aggName aggregate) (aggLoc aggregate)-        ++ concatMap-          (\register -> fieldNameRule "register name" (regName register) (regLoc register))-          (aggRegs aggregate)-        ++ concatMap commandNames (aggCommands aggregate)-        ++ concatMap eventNames (aggEvents aggregate)-        ++ maybe [] (\projection -> fieldNameRule "projection key" (projKey projection) (projLoc projection)) (aggProjection aggregate)-        ++ vertexCollisions aggregate-      where-        commandNames command =-          constructorName "command name" (cmdName command) (cmdLoc command)-            ++ concatMap (aggregateFieldNameRule "command field") (cmdFields command)-        eventNames event =-          constructorName "event name" (evName event) (evLoc event)-            ++ case evBody event of-              EventFields fields -> concatMap (aggregateFieldNameRule "event field") fields-              EventFromCommand _ -> []--    processNames process =-      constructorName "process name" (procId process) (procLoc process)-        ++ constructorName "process input name" (inName input) (procLoc process)-        ++ concatMap (\field -> fieldNameRule "process input field" (fieldName field) (procLoc process)) (inFields input)-        ++ concatMap (bindingName "advance field binding" (procLoc process)) (advFields (hAdvance handle))-        ++ concatMap dispatchBindings (hDispatch handle)-        ++ concatMap (bindingName "timer payload field binding" (tmLoc timer)) (tmPayload timer)-        ++ concatMap (bindingName "timer fire field binding" (tmLoc timer)) (fireFields (tmFire timer))-      where-        input = procInput process-        handle = procHandle process-        timer = procTimer process-        dispatchBindings dispatch = concatMap (bindingName "dispatch field binding" (dispLoc dispatch)) (dispFields dispatch)--    routerNames router =-      constructorName "router name" (rtId router) (rtLoc router)-        ++ constructorName "router input name" (inName input) (rtLoc router)-        ++ concatMap (\field -> fieldNameRule "router input field" (fieldName field) (rtLoc router)) (inFields input)-        ++ concatMap (\field -> fieldNameRule "router resolve-row field" field (rvLoc resolve)) (rvRow resolve)-        ++ concatMap (bindingName "router dispatch field binding" (rdLoc dispatch)) (rdFields dispatch)-      where-        input = rtInput router-        resolve = rtResolve router-        dispatch = rtDispatch router--    bindingName category anchor binding = fieldNameRule category (fbName binding) anchor-    contractFieldName = contractFieldNameRule "contract field"--    aggregateFieldNameRule category field =-      case aggregateFieldSelector field of-        Nothing -> fieldNameRule category (aggregateFieldName field) (aggregateFieldLoc field)-        Just selector -> explicitFieldSelectorRule category (aggregateFieldName field) selector (aggregateFieldLoc field)--    contractFieldNameRule category field =-      case cfSelector field of-        Nothing -> fieldNameRule category (cfName field) (cfLoc field)-        Just selector -> explicitFieldSelectorRule category (cfName field) selector (cfLoc field)--    explicitFieldSelectorRule category dslName selector anchor =-      case HaskellName.checkedLowerOccurrence site selector of-        Right _ -> []-        Left nameError -> [nameErrorDiagnostic (category <> " selector") nameError]-      where-        site =-          HaskellName.NameSite-            { HaskellName.siteKind = HaskellName.GeneratedFieldSite,-              HaskellName.siteLogicalName = selector,-              HaskellName.siteOwner = category <> ":" <> dslName,-              HaskellName.siteLine = locLine anchor-            }--    constructorName category name anchor = checkedLogicalName HaskellName.GeneratedTypeSite category name anchor--    workflowNames workflow =-      constructorName "workflow name" (wfId workflow) (workflowNodeLoc workflow)-        <> concat-          [ case HaskellName.deriveLowerHelperName HaskellName.LogicalWireWord "Await" site of-              Right _ -> []-              Left nameError -> [nameErrorDiagnostic "workflow await binding" nameError]-          | (label, loc) <- workflowAwaits (wfBody workflow),-            let site = workflowAwaitBindingSite workflow label loc-          ]--    pascalizedNodeName category name anchor = checkedLogicalName HaskellName.NodeModuleSite (category <> " name") name anchor--    fieldNameRule category name anchor = checkedLogicalName HaskellName.GeneratedFieldSite category name anchor--    checkedLogicalName kind category name anchor =-      case deriveAt HaskellName.LogicalIdentifier kind category name anchor of-        Right _ -> []-        Left nameError -> [nameErrorDiagnostic category nameError]--    deriveAt source kind category name anchor =-      HaskellName.deriveHaskellName source (nameSite kind category name anchor)--    nameSite kind category name anchor =-      HaskellName.NameSite-        { HaskellName.siteKind = kind,-          HaskellName.siteLogicalName = name,-          HaskellName.siteOwner = category <> ":" <> name,-          HaskellName.siteLine = locLine anchor-        }--    nameErrorDiagnostic category = \case-      HaskellName.EmptyNameSegment site ->-        mkErr (HaskellName.siteLine site) IdentUnsafeNormalization $-          category <> " '" <> HaskellName.siteLogicalName site <> "' has an empty generated-Haskell word"-      HaskellName.UnsafeNameSeparator site reason ->-        mkErr (HaskellName.siteLine site) IdentUnsafeNormalization $-          category <> " '" <> HaskellName.siteLogicalName site <> "' cannot be normalized safely: " <> reason-      HaskellName.ReservedGeneratedOccurrence site occurrence ->-        mkErr (HaskellName.siteLine site) GeneratedOccurrenceReserved $-          category <> " '" <> HaskellName.siteLogicalName site <> "' normalizes to reserved Haskell occurrence '" <> occurrence <> "'"-      HaskellName.InvalidExplicitHaskellName site occurrence ->-        mkErr (HaskellName.siteLine site) IdentUnsafeNormalization $-          category <> " '" <> HaskellName.siteLogicalName site <> "' cannot become generated Haskell occurrence '" <> occurrence <> "'"-      collision@HaskellName.NormalizedNameCollision {} -> collisionDiagnostic collision--    normalizedCollisions = map collisionDiagnostic (HaskellName.detectNameCollisions collisionOccurrences)--    collisionOccurrences =-      nodeModuleOccurrences-        <> sharedTypeOccurrences-        <> concatMap aggregateFieldOccurrences aggregates-        <> concatMap aggregateHarnessOccurrences aggregates-        <> concatMap contractFieldOccurrences contracts-        <> concatMap workflowRuntimeOccurrences workflows--    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]-    contracts = [contract | NContract contract <- specNodes spec]-    workflows = [workflow | NWorkflow workflow <- specNodes spec]--    contextSegment =-      case deriveAt HaskellName.LogicalWireWord HaskellName.ContextModuleSite "context" (specContext spec) (Loc 1) of-        Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-        Left _ -> specContext spec--    nodeModuleOccurrences =-      [ HaskellName.plannedOccurrence contextSegment HaskellName.ModuleSpace "" rendered site-      | node <- specNodes spec,-        let (category, raw, anchor) = nodeNameAndLoc node,-        let site = nameSite HaskellName.NodeModuleSite category raw anchor,-        Right derived <- [HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site],-        let rendered = HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-      ]--    sharedTypeOccurrences =-      [ HaskellName.plannedOccurrence ("Generated." <> contextSegment <> ".Nominals") HaskellName.TypeSpace "" rendered site-      | (category, raw, anchor) <--          [("id", idName declaration, idLoc declaration) | declaration <- specIds spec]-            <> [("enum", enumName declaration, enumLoc declaration) | declaration <- specEnums spec]-            <> [("nominal", nominalScalarName declaration, nominalScalarLoc declaration) | declaration <- specNominalScalars spec],-        let site = nameSite HaskellName.GeneratedTypeSite category raw anchor,-        Right derived <- [HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site],-        let rendered = HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-      ]--    aggregateFieldOccurrences aggregate = commandFields <> eventFields-      where-        targetModule = "Generated." <> contextSegment <> "." <> normalizedUpper "aggregate" (aggName aggregate) (aggLoc aggregate) <> ".Domain"-        commandFields =-          [ fieldOccurrence targetModule (cmdName command) "command field" field-          | command <- aggCommands aggregate,-            field <- cmdFields command-          ]-        eventFields =-          [ fieldOccurrence targetModule (evName event) "event field" field-          | event <- aggEvents aggregate,-            field <- eventFieldsFor aggregate event-          ]--    eventFieldsFor aggregate event =-      case evBody event of-        EventFields fields -> fields-        EventFromCommand commandName ->-          [ field-          | command <- aggCommands aggregate,-            cmdName command == commandName,-            field <- cmdFields command-          ]--    -- The occurrence registered here must be the selector generation actually-    -- emits — 'resolveAggregateFieldIdentity', which falls back to the raw DSL-    -- name, not a camelized rendering of it. Registering the camelized form made-    -- the planner claim `foo_bar` "normalizes to" `fooBar`, which generation-    -- never does, and let two fields that generate distinct selectors be-    -- reported as colliding. A field whose raw name is not lowerCamelCase is-    -- still refused, by the generated-name audit that owns that rule and says so.-    fieldOccurrence targetModule scope category field =-      let identity = resolveAggregateFieldIdentity field-          site = nameSite HaskellName.GeneratedFieldSite category (fieldDslName identity) (aggregateFieldLoc field)-       in HaskellName.plannedOccurrence targetModule HaskellName.FieldSpace scope (fieldSelector identity) site--    aggregateHarnessOccurrences aggregate =-      transitionHelpers <> sampleConstants-      where-        transitionHelpers =-          concat-            [ [helperOccurrence "accept" ("accept" <> commandName) transition]-                <> [helperOccurrence "forward/replay" ("forwardReplay" <> commandName) transition | not (null (tEmits transition))]-            | transition <- aggTransitions aggregate,-              tSource transition == initialState,-              tMode transition == TmLive,-              let commandName = tCommand transition-            ]-        sampleConstants = map idSampleOccurrence generatedIds <> maybe [] (pure . timeSampleOccurrence) timeSample-        resolvedHarnessFields =-          [ (field, resolvedType)-          | (useSite, field) <- harnessFields aggregate,-            Right resolvedType <- [inferAggregateFieldType symbols aggregate useSite field]-          ]-        generatedIds =-          Map.elems . Map.fromList $-            [ (Nominal.resolvedNominalName nominal, nominal)-            | (_, AggregateNominal nominal) <- resolvedHarnessFields,-              Nominal.GeneratedNominal <- [Nominal.resolvedNominalOwnership nominal],-              Nominal.IdRepresentation prefix <- [Nominal.resolvedNominalRepresentation nominal],-              idDomainContractFor languageContract prefix /= Nothing-            ]-        timeFields = [field | (field, AggregateTime) <- resolvedHarnessFields]-        timeSample = case filter ((== "observedAt") . aggregateFieldName) timeFields of-          field : _ -> Just ("sampleObservedAt", field)-          [] -> case timeFields of-            field : _ -> Just ("sampleTime", field)-            [] -> Nothing-        initialState = case aggStates aggregate of-          state : _ -> stName state-          [] -> ""-        symbols = aggregateSymbolsFromGraphResult typeGraphResult spec-        targetModule =-          "Generated."-            <> contextSegment-            <> "."-            <> normalizedUpper "aggregate" (aggName aggregate) (aggLoc aggregate)-            <> ".Harness"-        helperOccurrence helperKind rendered transition =-          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site-          where-            site =-              HaskellName.NameSite-                { HaskellName.siteKind = HaskellName.GeneratedHelperSite,-                  HaskellName.siteLogicalName = tCommand transition,-                  HaskellName.siteOwner = "aggregate:" <> aggName aggregate <> ":" <> helperKind <> ":line:" <> T.pack (show (locLine (tLoc transition))),-                  HaskellName.siteLine = locLine (tLoc transition)-                }-        idSampleOccurrence nominal =-          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" ("sample" <> nominalName) site-          where-            nominalName = Nominal.resolvedNominalName nominal-            nominalLoc = Nominal.resolvedNominalLoc nominal-            site =-              HaskellName.NameSite-                { HaskellName.siteKind = HaskellName.GeneratedHelperSite,-                  HaskellName.siteLogicalName = nominalName,-                  HaskellName.siteOwner = "aggregate:" <> aggName aggregate <> ":sample-id:" <> nominalName,-                  HaskellName.siteLine = locLine nominalLoc-                }-        timeSampleOccurrence (rendered, field) =-          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site-          where-            site =-              HaskellName.NameSite-                { HaskellName.siteKind = HaskellName.GeneratedHelperSite,-                  HaskellName.siteLogicalName = aggregateFieldName field,-                  HaskellName.siteOwner = "aggregate:" <> aggName aggregate <> ":sample-time",-                  HaskellName.siteLine = locLine (aggregateFieldLoc field)-                }--    workflowRuntimeOccurrences workflow =-      [ HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site-      | (label, loc) <- workflowAwaits (wfBody workflow),-        let site = workflowAwaitBindingSite workflow label loc,-        Right awaitName <- [HaskellName.deriveLowerHelperName HaskellName.LogicalWireWord "Await" site],-        let rendered = HaskellName.renderLowerCamelName awaitName-      ]-      where-        targetModule =-          "Generated."-            <> contextSegment-            <> "."-            <> normalizedUpper "workflow" (wfId workflow) (workflowNodeLoc workflow)-            <> ".WorkflowRuntime"--    workflowAwaitBindingSite workflow label loc =-      HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedValueSite,-          HaskellName.siteLogicalName = label,-          HaskellName.siteOwner = "workflow:" <> wfId workflow <> ":await:" <> label,-          HaskellName.siteLine = locLine loc-        }--    workflowAwaits = concatMap go-      where-        go (WfAwait label _ loc) = [(label, loc)]-        go (WfPatch _ items _) = workflowAwaits items-        go _ = []--    harnessFields aggregate =-      [(CommandFieldUse, field) | command <- aggCommands aggregate, field <- cmdFields command]-        <> [ (EventFieldUse, field)-           | event <- aggEvents aggregate,-             field <- eventFieldsFor aggregate event-           ]--    contractFieldOccurrences contract =-      [ contractFieldOccurrence targetModule (ceName event <> "Data") field-      | event <- ctrEvents contract,-        field <- ceFields event-      ]-      where-        targetModule =-          "Generated."-            <> contextSegment-            <> "."-            <> normalizedUpper "contract" (ctrName contract) (ctrLoc contract)-            <> ".Contract"--    contractFieldOccurrence targetModule scope field =-      let identity = resolveContractFieldIdentity field-          site = nameSite HaskellName.GeneratedFieldSite "contract field" (fieldDslName identity) (fieldLoc identity)-          rendered = case cfSelector field of-            Just selector -> selector-            Nothing -> case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-              Right derived -> HaskellName.renderLowerCamelName (HaskellName.lowerCamel derived)-              Left _ -> fieldSelector identity-       in HaskellName.plannedOccurrence targetModule HaskellName.FieldSpace scope rendered site--    normalizedUpper category raw anchor =-      case deriveAt HaskellName.LogicalIdentifier HaskellName.GeneratedTypeSite category raw anchor of-        Right derived -> HaskellName.renderUpperCamelName (HaskellName.upperCamel derived)-        Left _ -> raw--    nodeNameAndLoc = \case-      NAggregate value -> ("aggregate", aggName value, aggLoc value)-      NProcess value -> ("process", procId value, procLoc value)-      NRouter value -> ("router", rtId value, rtLoc value)-      NContract value -> ("contract", ctrName value, ctrLoc value)-      NIntake value -> ("intake", inkName value, inkLoc value)-      NEmit value -> ("emit", emName value, emLoc value)-      NPublisher value -> ("publisher", pubName value, pubLoc value)-      NWorkqueue value -> ("workqueue", wqName value, wqLoc value)-      NPgmqDispatch value -> ("dispatch", pdName value, pdLoc value)-      NReadModel value -> ("readmodel", rmName value, rmLoc value)-      NProjectionTarget value -> ("target", ptName value, ptLoc value)-      NRebuildGroup value -> ("rebuild-group", rgName value, rgLoc value)-      NProjectionRevision value -> ("projection-revision", prvName value, prvLoc value)-      NExternalRead value -> ("external-read", externalReadNodeIdentity value, erLoc value)-      NProjectionOwner value -> ("projection-owner", poName value, poLoc value)-      NWorkflow value -> ("workflow", wfId value, workflowNodeLoc value)-      NOperation value -> ("operation", opName value, opLoc value)--    collisionDiagnostic (HaskellName.NormalizedNameCollision key sites) =-      case reverse (NE.toList sites) of-        primary : reversedEarlier ->-          Diagnostic-            { line = HaskellName.siteLine primary,-              severity = Error,-              code = GeneratedOccurrenceCollision,-              relatedLocations =-                [ (HaskellName.siteLine site, "'" <> HaskellName.siteLogicalName site <> "' also normalizes here")-                | site <- reverse reversedEarlier-                ],-              message =-                "logical declarations "-                  <> T.intercalate ", " ["'" <> HaskellName.siteLogicalName site <> "'" | site <- NE.toList sites]-                  <> " normalize to the same Haskell occurrence '"-                  <> HaskellName.occurrenceName key-                  <> "' in "-                  <> HaskellName.occurrenceModule key-                  <> " ("-                  <> T.pack (show (HaskellName.occurrenceSpace key))-                  <> ")"-            }-        [] -> mkErr 1 GeneratedOccurrenceCollision "internal error: normalized collision without source sites"-    collisionDiagnostic nameError = nameErrorDiagnostic "generated declaration" nameError--    vertexCollisions aggregate =-      [ mkErr (locLine (aggLoc aggregate)) VertexCtorCollision $-          "aggregate '"-            <> aggName aggregate-            <> "' state '"-            <> stName state-            <> "' generates vertex constructor '"-            <> vertex-            <> "', which collides with "-            <> declarationKind-            <> " '"-            <> vertex-            <> "' in the generated Domain constructor namespace"-      | state <- aggStates aggregate,-        let vertex = normalizedUpper "aggregate" (aggName aggregate) (aggLoc aggregate) <> normalizedUpper "state" (stName state) (stLoc state),-        declarationKind <- collisionKinds aggregate vertex-      ]--    collisionKinds aggregate vertex =-      ["event" | vertex `elem` [normalizedUpper "event" (evName event) (evLoc event) | event <- aggEvents aggregate]]-        ++ ["command" | vertex `elem` [normalizedUpper "command" (cmdName command) (cmdLoc command) | command <- aggCommands aggregate]]-        ++ ["enum constructor" | vertex `elem` [normalizedUpper "enum constructor" ctor (enumLoc enum) | enum <- specEnums spec, (ctor, _) <- enumCtors enum]]---- Explicit consumer-owned Haskell references keep their spelling and use the--- historical lexical check. Generated names never call this helper.-constructorSafe :: Name -> Bool-constructorSafe name = case T.uncons name of-  Just (first, rest) -> asciiUpper first && T.all asciiAlphaNumOrUnderscore rest-  Nothing -> False--asciiUpper :: Char -> Bool-asciiUpper c = c >= 'A' && c <= 'Z'--asciiLower :: Char -> Bool-asciiLower c = c >= 'a' && c <= 'z'--asciiAlphaNumOrUnderscore :: Char -> Bool-asciiAlphaNumOrUnderscore c = asciiUpper c || asciiLower c || (c >= '0' && c <= '9') || c == '_'--kafkaTopicError :: Text -> Maybe Text-kafkaTopicError topic-  | T.null topic = Just "is empty"-  | T.length topic > 249 = Just "is longer than Kafka's 249-character limit"-  | topic == "." || topic == ".." = Just "is reserved by Kafka"-  | Just illegal <- T.find (not . kafkaTopicCharacter) topic =-      Just ("contains character " <> T.pack (show illegal) <> "; use only ASCII letters, digits, '.', '_', or '-'")-  | otherwise = Nothing-  where-    kafkaTopicCharacter character = asciiAlphaNumOrUnderscore character || character == '.' || character == '-'--validPostgresIdentifier :: Text -> Bool-validPostgresIdentifier identifier =-  T.length identifier <= 63-    && case T.uncons identifier of-      Nothing -> False-      Just (firstCharacter, rest) ->-        (asciiLower firstCharacter || firstCharacter == '_')-          && T.all (\character -> asciiLower character || (character >= '0' && character <= '9') || character == '_') rest---- | Rules over namespaces shared by the whole specification.-specLevelRules :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> [Diagnostic]-specLevelRules languageContract supplyAnalysis spec = duplicateNodes ++ duplicateEnumMembers ++ duplicateIdPrefixes ++ duplicateDeclarations ++ runtimeIdentities ++ duplicateRuntimeIdentities ++ catalogRules ++ ruleDiagnostics-  where-    duplicateNodes =-      [ mkErr (locLine loc) DuplicateNodeName $-          "duplicate " <> kind <> " node name '" <> name <> "'"-      | node <- duplicatesBy nodeKey (specNodes spec),-        let (kind, name, loc) = nodeIdentity node-      ]-    nodeKey node = let (kind, name, _) = nodeIdentity node in (kind, name)-    duplicateEnumMembers = concatMap enumDuplicates (specEnums spec)-    enumDuplicates e =-      [ mkErr (locLine (enumLoc e)) DuplicateEnumCtor $-          "enum '" <> enumName e <> "' declares constructor '" <> ctor <> "' more than once"-      | (ctor, _) <- duplicatesBy fst (enumCtors e)-      ]-        ++ [ mkErr (locLine (enumLoc e)) DuplicateEnumWire $-               "enum '" <> enumName e <> "' declares wire spelling '" <> wire <> "' more than once"-           | (_, wire) <- duplicatesBy snd (enumCtors e)-           ]-    duplicateIdPrefixes =-      [ mkErr (locLine (idLoc d)) DuplicateIdPrefix $-          "id '" <> idName d <> "' reuses prefix '" <> idPrefix d <> "'"-      | d <- duplicatesBy idPrefix (specIds spec)-      ]-    duplicateDeclarations =-      [ mkErr (locLine loc) NominalDuplicateDeclaration $-          "duplicate " <> category <> " declaration '" <> name <> "'; the last declaration would silently replace the earlier one"-      | enforcesSpecSurfaceClosures languageContract,-        (category, name, loc) <- duplicatesBy (\(category, name, _) -> (category, name)) declarationOrigins-      ]-    declarationOrigins =-      [("id", idName value, idLoc value) | value <- specIds spec]-        <> [("enum", enumName value, enumLoc value) | value <- specEnums spec]-        <> [("nominal scalar", nominalScalarName value, nominalScalarLoc value) | value <- specNominalScalars spec]-        <> [("mapped", mappedName value, mappedLoc value) | value <- specMapped spec]-        <> [("rule", ruleName value, ruleLoc value) | value <- specRules spec]-    runtimeIdentities =-      [ mkErr (locLine loc) RuntimeIdentityInvalid $-          kind <> " stable identity " <> T.pack (show identity) <> " " <> reason-      | enforcesSpecSurfaceClosures languageContract,-        (kind, identity, loc) <- stableIdentityOrigins,-        Just reason <- [stableIdentityError identity]-      ]-    duplicateRuntimeIdentities =-      [ mkErr (locLine loc) RuntimeIdentityDuplicate $-          kind <> " stable identity " <> T.pack (show identity) <> " is already used by another workflow, process, or router"-      | enforcesSpecSurfaceClosures languageContract,-        (kind, identity, loc) <- duplicatesBy (\(_, identity, _) -> identity) stableIdentityOrigins-      ]-    stableIdentityOrigins =-      [("workflow", wfStable workflow, workflowNodeLoc workflow) | NWorkflow workflow <- specNodes spec]-        <> [("process", procName process, procLoc process) | NProcess process <- specNodes spec]-        <> [("router", rtName router, rtLoc router) | NRouter router <- specNodes spec]-    catalogRules-      | hasProjectionCatalog languageContract = validateProjectionCatalogFleet supplyAnalysis spec-      | otherwise = []-    ruleDiagnostics = concatMap (validateRule spec) (specRules spec)--nodeIdentity :: Node -> (Text, Name, Loc)-nodeIdentity (NAggregate a) = ("aggregate", aggName a, aggLoc a)-nodeIdentity (NProcess p) = ("process", procId p, procLoc p)-nodeIdentity (NRouter r) = ("router", rtId r, rtLoc r)-nodeIdentity (NContract c) = ("contract", ctrName c, ctrLoc c)-nodeIdentity (NIntake i) = ("intake", inkName i, inkLoc i)-nodeIdentity (NEmit e) = ("emit", emName e, emLoc e)-nodeIdentity (NPublisher p) = ("publisher", pubName p, pubLoc p)-nodeIdentity (NWorkqueue w) = ("workqueue", wqName w, wqLoc w)-nodeIdentity (NPgmqDispatch d) = ("dispatch", pdName d, pdLoc d)-nodeIdentity (NReadModel r) = ("readmodel", rmName r, rmLoc r)-nodeIdentity (NProjectionTarget target) = ("target", ptName target, ptLoc target)-nodeIdentity (NRebuildGroup groupNode) = ("rebuild-group", rgName groupNode, rgLoc groupNode)-nodeIdentity (NProjectionRevision revision) = ("projection-revision", prvName revision, prvLoc revision)-nodeIdentity (NExternalRead externalRead) = ("external-read", externalReadNodeIdentity externalRead, erLoc externalRead)-nodeIdentity (NProjectionOwner owner) = ("projection-owner", poName owner, poLoc owner)-nodeIdentity (NWorkflow w) = ("workflow", wfId w, workflowNodeLoc w)-nodeIdentity (NOperation o) = ("operation", opName o, opLoc o)--validateNode :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> ProjectionSupplyAnalysis -> Spec -> Node -> [Diagnostic]-validateNode languageContract typeGraphResult _supplyAnalysis spec (NAggregate agg) = validateAggregate languageContract typeGraphResult spec agg-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NProcess p) = validateProcess languageContract spec p-validateNode languageContract typeGraphResult _supplyAnalysis spec (NRouter router) = validateRouter languageContract typeGraphResult spec router-validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NContract contract) = validateContract languageContract contract-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NIntake i) = validateIntake languageContract i ++ intakeCoupling languageContract spec i-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NEmit e) = validateEmit languageContract spec e-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NPublisher p) = validatePublisher languageContract spec p-validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NWorkqueue w) = validateWorkqueue languageContract w-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NPgmqDispatch d) = validatePgmqDispatch languageContract spec d-validateNode languageContract _typeGraphResult supplyAnalysis spec (NReadModel readModel) = validateReadModel languageContract supplyAnalysis spec readModel-validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NProjectionTarget target) = validateProjectionTarget languageContract target-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NRebuildGroup groupNode) = validateRebuildGroup languageContract spec groupNode-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NProjectionRevision revision) = validateProjectionRevision languageContract spec revision-validateNode languageContract _typeGraphResult _supplyAnalysis spec (NExternalRead externalRead) = validateExternalRead languageContract spec externalRead-validateNode languageContract _typeGraphResult supplyAnalysis spec (NProjectionOwner owner) = validateProjectionOwner languageContract supplyAnalysis spec owner-validateNode _languageContract _typeGraphResult _supplyAnalysis _spec (NWorkflow w) = validateWorkflow w-validateNode _languageContract _typeGraphResult _supplyAnalysis spec (NOperation o) = validateOperation spec o--validateContract :: EffectiveLanguageContract -> ContractNode -> [Diagnostic]-validateContract languageContract contract =-  emptyContract-    <> typeIdPrefixErrors-    <> schemaVersionFloor-    <> topicNames-    <> duplicateEvents-    <> duplicateTopicAliases-    <> duplicateFields-    <> discriminatorShadows-    <> fieldWireKeyRules-    <> unresolvedTopicAliases-  where-    emptyContract =-      [ mkErr (locLine (ctrLoc contract)) ContractEmpty $-          "contract '"-            <> ctrName contract-            <> "' declares no events; scaffold cannot lower an empty contract -- declare at least one event"-      | null (ctrEvents contract)-      ]-    typeIdPrefixErrors =-      [ mkErr (locLine (cfLoc field)) ContractInvalidTypeIdPrefix $-          "contract '"-            <> ctrName contract-            <> "' event '"-            <> ceName event-            <> "' field '"-            <> cfName field-            <> "' has invalid TypeID prefix '"-            <> prefix-            <> "': "-            <> T.pack (show reason)-      | event <- ctrEvents contract,-        field <- ceFields event,-        CTypeId prefix <- [cfType field],-        Just _ <- [contractIdDomainContractFor languageContract prefix],-        Just reason <- [TypeID.checkPrefix prefix]-      ]-    schemaVersionFloor =-      [ mkErr (locLine (ctrLoc contract)) ContractSchemaVersionBelowMinimum $-          "contract '" <> ctrName contract <> "' schemaVersion must be at least 1"-      | enforcesSpecSurfaceClosures languageContract,-        ctrSchemaVersion contract < 1-      ]-    topicNames =-      [ mkErr (locLine (ctrLoc contract)) ContractTopicNameInvalid $-          "contract '" <> ctrName contract <> "' topic alias '" <> alias <> "' has invalid Kafka topic " <> T.pack (show topic) <> ": " <> reason-      | (alias, topic) <- ctrTopics contract,-        T.null topic || enforcesSpecSurfaceClosures languageContract,-        Just reason <- [kafkaTopicError topic]-      ]-    duplicateEvents =-      [ mkErr (locLine (ctrLoc contract)) ContractDuplicateEvent $-          "contract '" <> ctrName contract <> "' declares event '" <> ceName event <> "' more than once"-      | event <- duplicatesBy ceName (ctrEvents contract)-      ]-    duplicateTopicAliases =-      [ mkErr (locLine (ctrLoc contract)) ContractDuplicateTopicAlias $-          "contract '" <> ctrName contract <> "' declares topic alias '" <> alias <> "' more than once"-      | (alias, _) <- duplicatesBy fst (ctrTopics contract)-      ]-    duplicateFields =-      [ mkErr (locLine (cfLoc field)) ContractDuplicateFieldName $-          "contract '" <> ctrName contract <> "' event '" <> ceName event <> "' declares field '" <> cfName field <> "' more than once"-      | event <- ctrEvents contract,-        field <- duplicatesBy cfName (ceFields event)-      ]-    discriminatorShadows =-      [ mkErr (locLine (cfLoc field)) ContractFieldShadowsDiscriminator $-          "contract '"-            <> ctrName contract-            <> "' event '"-            <> ceName event-            <> "' field '"-            <> cfName field-            <> "' shadows the payload discriminator"-      | enforcesSpecSurfaceClosures languageContract,-        event <- ctrEvents contract,-        field <- ceFields event,-        fieldWireKey (resolveContractFieldIdentity field) == ctrDiscriminator contract-      ]-    fieldWireKeyRules =-      concat-        [ wireKeyRulesForRecord-            ("contract '" <> ctrName contract <> "' event '" <> ceName event <> "'")-            (Just (ctrDiscriminator contract, "payload discriminator"))-            (map resolveContractFieldIdentity (ceFields event))-        | event <- ctrEvents contract-        ]-    unresolvedTopicAliases =-      [ mkErr (locLine (ctrLoc contract)) ContractTopicAliasUnresolved $-          "contract '" <> ctrName contract <> "' event '" <> ceName event <> "' names undeclared topic alias '" <> ceTopic event <> "'"-      | enforcesSpecSurfaceClosures languageContract,-        event <- ctrEvents contract,-        ceTopic event `notElem` map fst (ctrTopics contract)-      ]---- | Workflow replay keys, patch guards, rotation, and injected inputs must be unambiguous.-validateWorkflow :: WorkflowNode -> [Diagnostic]-validateWorkflow w = duplicateLabels ++ sleepFields ++ patchDuplicates ++ patchIds ++ continuePositions ++ idField-  where-    inputFields = map fieldName (wfInputFields w)-    labelledItems = workflowLabelledItems (wfBody w)-    patchItems = workflowPatchItems (wfBody w)-    duplicateLabels =-      [ mkErr (locLine (wfBodyLoc item)) WorkflowDuplicateLabel $-          "workflow '" <> wfId w <> "' declares label '" <> label <> "' more than once; labels key deterministic replay, so a duplicate label replays the first occurrence's journaled result"-      | (label, item) <- duplicatesBy fst labelledItems-      ]-    sleepFields =-      [ mkErr (locLine loc) WorkflowSleepDelayUnresolved $-          "workflow '" <> wfId w <> "' sleep '" <> label <> "' references undeclared input field '" <> delay <> "'"-      | WfSleep label delay loc <- map snd labelledItems,-        delay `notElem` inputFields-      ]-    patchDuplicates =-      [ mkErr (locLine loc) WorkflowPatchDuplicate $-          "workflow '" <> wfId w <> "' declares patch id '" <> patchId <> "' more than once; patch decisions journal under one stable key"-      | (patchId, _, loc) <- duplicatesBy (\(patchId, _, _) -> patchId) patchItems-      ]-    patchIds =-      [ mkErr (locLine loc) WorkflowPatchIdInvalid $-          "workflow '" <> wfId w <> "' patch id '" <> patchId <> "' contains ':'; the runtime reserves that separator for the patch journal-key prefix"-      | (patchId, _, loc) <- patchItems,-        ":" `T.isInfixOf` patchId-      ]-    continuePositions =-      [ mkErr (locLine loc) WorkflowContinueAsNewNotTerminal $-          "workflow '" <> wfId w <> "' continueAsNew must be the last top-level body item and may not appear inside a patch"-      | (isTopLevelTerminal, loc) <- workflowContinueItems (wfBody w),-        not isTopLevelTerminal-      ]-    idField = case wfIdField w of-      Just field-        | field `notElem` inputFields ->-            [ mkErr (locLine (workflowNodeLoc w)) WorkflowIdFieldUnresolved $-                "workflow '" <> wfId w <> "' derives its id from undeclared input field '" <> field <> "'"-            ]-      _ -> []--wfBodyLoc :: WfBodyItem -> Loc-wfBodyLoc (WfStep _ _ loc) = loc-wfBodyLoc (WfAwait _ _ loc) = loc-wfBodyLoc (WfSleep _ _ loc) = loc-wfBodyLoc (WfChild _ _ _ loc) = loc-wfBodyLoc (WfPatch _ _ loc) = loc-wfBodyLoc (WfContinueAsNew _ loc) = loc--workflowLabelledItems :: [WfBodyItem] -> [(Name, WfBodyItem)]-workflowLabelledItems = concatMap go-  where-    go item@(WfStep label _ _) = [(label, item)]-    go item@(WfAwait label _ _) = [(label, item)]-    go item@(WfSleep label _ _) = [(label, item)]-    go item@(WfChild label _ _ _) = [(label, item)]-    go (WfPatch _ items _) = workflowLabelledItems items-    go WfContinueAsNew {} = []--workflowPatchItems :: [WfBodyItem] -> [(Name, [WfBodyItem], Loc)]-workflowPatchItems = concatMap go-  where-    go (WfPatch patchId items loc) = (patchId, items, loc) : workflowPatchItems items-    go _ = []---- | Pair every rotation with whether it is the final top-level item.-workflowContinueItems :: [WfBodyItem] -> [(Bool, Loc)]-workflowContinueItems items = topLevel ++ nested-  where-    topLevel =-      [ (index == length items - 1, loc)-      | (index, WfContinueAsNew _ loc) <- zip [0 ..] items-      ]-    nested =-      [ (False, loc)-      | WfPatch _ patchBody _ <- items,-        (_, loc) <- workflowContinueItems patchBody-      ]---- | A top-level rule is a total, clock-free function over one declared enum.-validateRule :: Spec -> RuleDecl -> [Diagnostic]-validateRule spec rule = case [e | e <- specEnums spec, enumName e == ruleDomain rule] of-  [] ->-    [ mkErr rl RuleDomainUnresolved $-        "rule '" <> ruleName rule <> "' has undeclared enum domain '" <> ruleDomain rule <> "'"-    ]-  (domain : _) -> totality domain ++ unknownCases domain ++ bodyDiagnostics-  where-    rl = locLine (ruleLoc rule)-    caseNames = map fst (ruleCases rule)-    allEnumCtors = Set.fromList [ctor | e <- specEnums spec, (ctor, _) <- enumCtors e]-    totality domain =-      let missing = [ctor | (ctor, _) <- enumCtors domain, ctor `notElem` caseNames]-       in [ mkErr rl RuleNotTotal $-              "rule '" <> ruleName rule <> "' is not total over enum '" <> enumName domain <> "'; missing cases {" <> T.intercalate ", " missing <> "}"-          | not (null missing)-          ]-    unknownCases domain =-      [ mkErr rl RuleCaseUnknownCtor $-          "rule '" <> ruleName rule <> "' has case '" <> ctor <> "' which is not a constructor of enum '" <> enumName domain <> "'"-      | (ctor, _) <- ruleCases rule,-        ctor `notElem` map fst (enumCtors domain)-      ]-    bodyDiagnostics = concatMap validateBody (ruleCases rule)-    validateBody (ctor, expr) =-      [ mkErr rl ClockSampled $-          "rule '" <> ruleName rule <> "' case '" <> ctor <> "' samples the wall clock via '" <> atom <> "'; rules must be deterministic"-      | atom <- dedup (exprNames expr),-        atom `Set.member` clockAtoms-      ]-        ++ [ mkErr rl GuardAtomOutOfScope $-               "atom '" <> atom <> "' in rule '" <> ruleName rule <> "' resolves to no enum constructor or boolean literal"-           | atom <- dedup (exprNames expr),-             atom `Set.notMember` clockAtoms,-             atom `Set.notMember` allEnumCtors-           ]---- | Operation rules resolve command aggregates, stream fields, projections,--- read models, workflow signal labels and value types, and run targets.-validateOperation :: Spec -> OperationNode -> [Diagnostic]-validateOperation spec o = case opShape o of-  CommandOp aggregate streamField _ projections ->-    aggregateRef aggregate streamField ++ projectionRefs projections-  QueryOp readModel _ _ consistency ->-    resolveReadModelRef QueryUnresolvedReadModel spec (opLoc o) ("query operation '" <> opName o <> "'") readModel-      ++ [ mkErr ol QueryConsistencyInvalid $-             "query operation '" <> opName o <> "' has unknown consistency '" <> consistency <> "'; expected Strong, Eventual, or PositionWait"-         | consistency `notElem` (["Strong", "Eventual", "PositionWait"] :: [Name])-         ]-  SignalOp lbl wf _ _ valueType ->-    case lookupWorkflow wf of-      Nothing ->-        [mkErr ol AwaitSignalMismatch ("signal operation '" <> opName o <> "' targets undeclared workflow '" <> wf <> "'")]-      Just w -> case [(resultType, loc) | (_, WfAwait label resultType loc) <- workflowLabelledItems (wfBody w), label == lbl] of-        [] ->-          [ mkErr ol AwaitSignalMismatch $-              "signal '" <> lbl <> "' of " <> wf <> " has no matching 'await' (workflow declares awaits {" <> T.intercalate ", " (awaitLabels w) <> "}); the deterministic awakeable id will not match and the workflow will wait forever"-          ]-        ((resultType, _) : _)-          | valueType == resultType -> []-          | otherwise ->-              [ mkErr ol AwaitSignalValueMismatch $-                  "signal '" <> lbl <> "' of " <> wf <> " carries value type '" <> valueType <> "' but the await expects '" <> resultType <> "'"-              ]-  RunOp wf _ _ ->-    [ mkErr ol RunWorkflowUnresolved ("run operation '" <> opName o <> "' targets undeclared workflow '" <> wf <> "'")-    | wf `notElem` map wfId workflows-    ]-  where-    ol = locLine (opLoc o)-    workflows = [w | NWorkflow w <- specNodes spec]-    aggregates = [a | NAggregate a <- specNodes spec]-    projectionTables = [projTable p | a <- aggregates, Just p <- [aggProjection a]]-    lookupWorkflow n = case [w | w <- workflows, wfId w == n] of (w : _) -> Just w; [] -> Nothing-    awaitLabels w = [l | (_, WfAwait l _ _) <- workflowLabelledItems (wfBody w)]-    aggregateRef name streamField = case [a | a <- aggregates, aggName a == name] of-      [] ->-        [ mkErr ol OperationUnresolvedRef $-            "command operation '" <> opName o <> "' targets undeclared aggregate '" <> name <> "'"-        ]-      (aggregate : _) ->-        [ mkErr ol OperationUnresolvedRef $-            "command operation '" <> opName o <> "' stream field '" <> streamField <> "' is not declared by any command of aggregate '" <> name <> "'"-        | streamField `notElem` [aggregateFieldName field | command <- aggCommands aggregate, field <- cmdFields command]-        ]-    projectionRefs projections =-      [ mkErr ol OperationUnresolvedRef $-          "command operation '" <> opName o <> "' references undeclared projection table '" <> projection <> "'"-      | projection <- projections,-        projection `notElem` projectionTables-      ]---- | Resolve a named read-model node using the caller's diagnostic code.-resolveReadModelRef :: DiagnosticCode -> Spec -> Loc -> Text -> Name -> [Diagnostic]-resolveReadModelRef diagnosticCode spec diagnosticLoc context name =-  [ mkErr (locLine diagnosticLoc) diagnosticCode $-      context <> " references undeclared readmodel '" <> name <> "'"-  | name `notElem` [rmName readModel | NReadModel readModel <- specNodes spec]-  ]--validateProjectionCatalogFleet :: ProjectionSupplyAnalysis -> Spec -> [Diagnostic]-validateProjectionCatalogFleet supplyAnalysis spec = physicalDuplicates <> groupOwnership <> projectionOwnership <> targetDependencies <> handlerOrders <> sourceOrdering <> supplyDiagnostics-  where-    targets = [target | NProjectionTarget target <- specNodes spec]-    groups = [groupNode | NRebuildGroup groupNode <- specNodes spec]-    owners = [owner | NProjectionOwner owner <- specNodes spec]-    physicalDuplicates =-      [ mkErr (locLine (ptLoc target)) CatalogPhysicalTargetDuplicate $-          "target '" <> ptName target <> "' reuses physical table " <> ptSchema target <> "." <> ptTable target-      | target <- duplicatesBy (\target -> (ptSchema target, ptTable target)) targets-      ]-    targetClaims = [(targetName, rgName groupNode, rgLoc groupNode) | groupNode <- groups, targetName <- rgTargets groupNode]-    groupOwnership =-      [ mkErr (locLine (ptLoc target)) CatalogTargetUnowned $-          "target '" <> ptName target <> "' is not owned by any rebuild group"-      | target <- targets,-        null [() | (targetName, _, _) <- targetClaims, targetName == ptName target]-      ]-        <> [ mkErr (locLine claimLoc) CatalogTargetMultiplyOwned $-               "target '" <> targetName <> "' is owned by more than one rebuild group"-           | (targetName, _, claimLoc) <- duplicatesBy (\(targetName, _, _) -> targetName) targetClaims-           ]-    projectionClaims = [(targetName, poName owner, poLoc owner) | owner <- owners, targetName <- poTargets owner]-    projectionOwnership =-      [ mkErr (locLine (ptLoc target)) CatalogTargetUnowned $-          "target '" <> ptName target <> "' has no projection owner"-      | target <- targets,-        null [() | (targetName, _, _) <- projectionClaims, targetName == ptName target]-      ]-        <> [ mkErr (locLine claimLoc) CatalogTargetMultiplyOwned $-               "target '" <> targetName <> "' is claimed by more than one projection owner"-           | (targetName, _, claimLoc) <- duplicatesBy (\(targetName, _, _) -> targetName) projectionClaims-           ]-    groupForTarget = Map.fromList [(targetName, groupName) | (targetName, groupName, _) <- targetClaims]-    targetDependencies =-      [ mkErr (locLine (ptLoc target)) CatalogTargetDependencyUnknown $-          "target '" <> ptName target <> "' depends on undeclared target '" <> dependency <> "'"-      | target <- targets,-        dependency <- ptDependsOn target,-        dependency `notElem` map ptName targets-      ]-        <> [ mkErr (locLine (ptLoc target)) CatalogTargetDependencyOutsideGroup $-               "target '" <> ptName target <> "' depends on target '" <> dependency <> "' in another rebuild group"-           | target <- targets,-             dependency <- ptDependsOn target,-             Just ownerGroup <- [Map.lookup (ptName target) groupForTarget],-             Just dependencyGroup <- [Map.lookup dependency groupForTarget],-             ownerGroup /= dependencyGroup-           ]-        <> [ mkErr (locLine (ptLoc target)) CatalogTargetDependencyCycle $-               "target dependency cycle includes '" <> ptName target <> "'"-           | CyclicSCC cycleTargets <- stronglyConnComp [(target, ptName target, ptDependsOn target) | target <- targets],-             target <- cycleTargets-           ]-    handlerOrders =-      [ mkErr (locLine (poLoc owner)) CatalogDuplicateHandlerOrder $-          "projection owner '" <> poName owner <> "' reuses handler order " <> T.pack (show (poOrder owner)) <> " in group '" <> poGroup owner <> "'"-      | owner <- duplicatesBy (\owner -> (poGroup owner, poOrder owner)) owners-      ]-    sourceOrdering =-      [ Diagnostic-          { line = locLine (rgLoc groupNode),-            severity = Error,-            code = CatalogAmbiguousSourceOrdering,-            relatedLocations =-              [ (locLine (poLoc owner), "projection owner '" <> poName owner <> "' contributes " <> sourceScopeText owner <> " events")-              | owner <- groupOwners-              ],-            message =-              "rebuild group '"-                <> rgName groupNode-                <> "' cannot combine an all-stream source with category-scoped sources; split them into separate rebuild groups"-          }-      | groupNode <- groups,-        let groupOwners = sortOn poName [owner | owner <- owners, poGroup owner == rgName groupNode],-        any ownerUsesAllStreams groupOwners,-        any ownerUsesCategoryScope groupOwners-      ]-    ownerUsesAllStreams owner = CatalogAll `elem` poSources owner-    ownerUsesCategoryScope owner = any isCategoryScope (poSources owner)-    isCategoryScope CatalogAll = False-    isCategoryScope CatalogCategory {} = True-    isCategoryScope CatalogAggregate {} = True-    sourceScopeText owner-      | ownerUsesAllStreams owner = "all-stream"-      | otherwise = "category-scoped"-    supplyDiagnostics = concatMap projectionSupplyIssueDiagnostics (projectionSupplyIssues supplyAnalysis)--projectionSupplyIssueDiagnostics :: ProjectionSupplyIssue -> [Diagnostic]-projectionSupplyIssueDiagnostics = \case-  SupplyObservedTargetsEmpty readModel ->-    [ mkErr (locLine (rmLoc readModel)) CatalogReadModelBindingMissing $-        "readmodel '" <> rmName readModel <> "' must observe at least one target in its projection catalog group"-    ]-  SupplyObservedTargetUnknown readModel targetName ->-    [ mkErr (locLine (rmLoc readModel)) CatalogTargetUnknown $-        "readmodel '" <> rmName readModel <> "' observes undeclared target '" <> targetName <> "'"-    ]-  SupplyObservedTargetOutsideGroup readModel targetName ->-    [ mkErr (locLine (rmLoc readModel)) CatalogReadModelTargetOutsideGroup $-        "readmodel '" <> rmName readModel <> "' observes target '" <> targetName <> "' outside its bound group"-    ]-  SupplyObservedTargetWithoutOwner _ _ -> []-  SupplyObservedTargetWithMultipleOwners _ _ _ -> []-  SupplyOwnerGroupMismatch _ _ _ -> []-  SupplyQueryWithoutOwner readModel ->-    [ mkErr (locLine (rmLoc readModel)) CatalogReadModelSupplierMissing $-        "readmodel '" <> rmName readModel <> "' does not resolve to one projection owner through its observed targets"-    ]-  SupplyQueryWithMultipleOwners readModel owners ->-    [ Diagnostic-        { line = locLine (rmLoc readModel),-          severity = Error,-          code = CatalogReadModelMultipleSuppliers,-          relatedLocations =-            [ (locLine (poLoc owner), "projection owner '" <> poName owner <> "' supplies part of the observed target set")-            | owner <- sortOn poName owners-            ],-          message =-            "readmodel '"-              <> rmName readModel-              <> "' spans several projection owners ("-              <> T.intercalate ", " (map poName (sortOn poName owners))-              <> "); split the query or declare one owner for the complete observed target set"-        }-    ]-  SupplyLegacyProjectionConflict readModel aggregate projection ->-    [ Diagnostic-        { line = locLine (rmLoc readModel),-          severity = Error,-          code = CatalogReadModelLegacyProjectionConflict,-          relatedLocations =-            [ ( locLine (projLoc projection),-                "aggregate '" <> aggName aggregate <> "' also names this readmodel in its legacy projection clause"-              )-            ],-          message =-            "catalog-bound readmodel '"-              <> rmName readModel-              <> "' derives its supplier from projection-owner target ownership; remove the legacy aggregate projection clause"-        }-    ]--validateProjectionTarget :: EffectiveLanguageContract -> ProjectionTargetNode -> [Diagnostic]-validateProjectionTarget languageContract target =-  [ mkErr (locLine (ptLoc target)) ReadModelIdentifierInvalid $-      "target '" <> ptName target <> "' " <> kind <> " " <> T.pack (show identifier) <> " is not a PostgreSQL unquoted identifier"-  | hasProjectionCatalog languageContract,-    (kind, identifier) <- [("schema", ptSchema target), ("table", ptTable target)],-    not (validPostgresIdentifier identifier)-  ]--validateRebuildGroup :: EffectiveLanguageContract -> Spec -> RebuildGroupNode -> [Diagnostic]-validateRebuildGroup languageContract spec groupNode-  | not (hasProjectionCatalog languageContract) = []-  | otherwise = emptyTargets <> unknownTargets <> invalidOrder-  where-    targetNames = [ptName target | NProjectionTarget target <- specNodes spec]-    emptyTargets =-      [ mkErr (locLine (rgLoc groupNode)) CatalogGroupEmpty $-          "rebuild group '" <> rgName groupNode <> "' must own at least one target"-      | null (rgTargets groupNode)-      ]-    unknownTargets =-      [ mkErr (locLine (rgLoc groupNode)) CatalogTargetUnknown $-          "rebuild group '" <> rgName groupNode <> "' references undeclared target '" <> targetName <> "'"-      | targetName <- rgTargets groupNode,-        targetName `notElem` targetNames-      ]-    invalidOrder =-      [ mkErr (locLine (rgLoc groupNode)) CatalogGroupOrderMismatch $-          "rebuild group '" <> rgName groupNode <> "' order must contain each owned target exactly once"-      | Set.fromList (rgOrder groupNode) /= Set.fromList (rgTargets groupNode)-          || length (rgOrder groupNode) /= Set.size (Set.fromList (rgOrder groupNode))-          || length (rgTargets groupNode) /= Set.size (Set.fromList (rgTargets groupNode))-      ]--validateProjectionRevision :: EffectiveLanguageContract -> Spec -> ProjectionRevisionNode -> [Diagnostic]-validateProjectionRevision languageContract spec revisionNode-  | not (hasProjectionCatalog languageContract) = []-  | otherwise = noTargets <> unknownGroup <> unknownTargets <> duplicateTargets <> targetSetMismatch <> invalidIdentities <> invalidPromotionNames-  where-    declaredTargets = [ptName target | NProjectionTarget target <- specNodes spec]-    matchingGroups = [groupNode | NRebuildGroup groupNode <- specNodes spec, rgName groupNode == prvGroup revisionNode]-    revisionTargets = prvTargets revisionNode-    revisionTargetNames = map prtTarget revisionTargets-    noTargets =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionNoTarget $-          "projection revision '" <> prvName revisionNode <> "' must declare every target in its rebuild group"-      | null revisionTargets-      ]-    unknownGroup =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionGroupUnknown $-          "projection revision '" <> prvName revisionNode <> "' references undeclared rebuild group '" <> prvGroup revisionNode <> "'"-      | null matchingGroups-      ]-    unknownTargets =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionTargetUnknown $-          "projection revision '" <> prvName revisionNode <> "' references undeclared target '" <> prtTarget revisionTarget <> "'"-      | revisionTarget <- revisionTargets,-        prtTarget revisionTarget `notElem` declaredTargets-      ]-    duplicateTargets =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionDuplicateTarget $-          "projection revision '" <> prvName revisionNode <> "' declares target '" <> targetName <> "' more than once"-      | targetName <- duplicatesBy id revisionTargetNames-      ]-    targetSetMismatch =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionTargetSetMismatch $-          "projection revision '" <> prvName revisionNode <> "' target set must equal rebuild group '" <> prvGroup revisionNode <> "'"-      | groupNode : _ <- [matchingGroups],-        Set.fromList revisionTargetNames /= Set.fromList (rgTargets groupNode)-          || length revisionTargetNames /= Set.size (Set.fromList revisionTargetNames)-      ]-    invalidIdentities =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionIdentityInvalid $-          "projection revision '" <> prvName revisionNode <> "' target '" <> prtTarget revisionTarget <> "' has invalid " <> identityKind <> " identity/version"-      | revisionTarget <- revisionTargets,-        (identityKind, identity, version) <--          [ ("schema", prtSchemaVersion revisionTarget, 1),-            ("provisioner", prtProvisioner revisionTarget, prtProvisionerVersion revisionTarget),-            ("expected-shape", prtExpectedShape revisionTarget, 1),-            ("validator", prtValidator revisionTarget, prtValidatorVersion revisionTarget)-          ],-        T.null identity || T.strip identity /= identity || version <= 0-      ]-    invalidPromotionNames =-      [ mkErr (locLine (prvLoc revisionNode)) CatalogRevisionPromotionNameInvalid $-          "projection revision '" <> prvName revisionNode <> "' target '" <> prtTarget revisionTarget <> "' promotion names must be valid, unique PostgreSQL identifiers"-      | revisionTarget <- revisionTargets,-        let objects = prtPromotionObjects revisionTarget-            names = concat [[rpoGenerationName object, rpoCanonicalName object] | object <- objects],-        any (not . validPostgresIdentifier) names-          || length names /= Set.size (Set.fromList names)-      ]--validateExternalRead :: EffectiveLanguageContract -> Spec -> ExternalReadNode -> [Diagnostic]-validateExternalRead languageContract spec externalRead-  | not (hasProjectionCatalog languageContract) = []-  | otherwise =-      invalidIdentity-        <> invalidVersion-        <> unknownQuery-        <> invalidTargetCardinality-        <> invalidCompatibility-        <> unknownRevisions-        <> revisionGroupMismatch-        <> invalidSurfaceGeneration-  where-    diagnosticLine = locLine (erLoc externalRead)-    readModels = [readModel | NReadModel readModel <- specNodes spec]-    revisions = [revision | NProjectionRevision revision <- specNodes spec]-    matchingReadModels = [readModel | readModel <- readModels, rmName readModel == erQueryModel externalRead]-    matchingGroup = case matchingReadModels of-      readModel : _ -> rmGroup readModel-      [] -> Nothing-    invalidIdentity =-      [ mkErr diagnosticLine CatalogExternalReadIdentityInvalid $-          "external-read '"-            <> erName externalRead-            <> "' requires lower-case PostgreSQL identifiers for its contract, result schema, and result type"-      | any-          (not . validPostgresIdentifier)-          [erName externalRead, erResultSchema externalRead, erResultType externalRead]-      ]-    invalidVersion =-      [ mkErr diagnosticLine CatalogExternalReadVersionInvalid $-          "external-read '" <> erName externalRead <> "' version must be at least 1"-      | erVersion externalRead <= 0-      ]-    unknownQuery =-      [ mkErr diagnosticLine CatalogExternalReadQueryUnknown $-          "external-read '" <> erName externalRead <> "' references undeclared readmodel '" <> erQueryModel externalRead <> "'"-      | null matchingReadModels-      ]-    invalidTargetCardinality =-      [ mkErr diagnosticLine CatalogExternalReadTargetCardinalityInvalid $-          "external-read '"-            <> erName externalRead-            <> "' is the bounded all-row form and its readmodel must observe exactly one target"-      | readModel <- take 1 matchingReadModels,-        length (rmObservedTargets readModel) /= 1-      ]-    compatibleRevisions = erCompatibleRevisions externalRead-    invalidCompatibility =-      [ mkErr diagnosticLine CatalogExternalReadCompatibilityInvalid $-          "external-read '" <> erName externalRead <> "' must name at least one compatible projection revision without duplicates"-      | null compatibleRevisions-          || length compatibleRevisions /= Set.size (Set.fromList compatibleRevisions)-      ]-    unknownRevisions =-      [ mkErr diagnosticLine CatalogExternalReadRevisionUnknown $-          "external-read '" <> erName externalRead <> "' references undeclared projection revision '" <> revisionName <> "'"-      | revisionName <- compatibleRevisions,-        revisionName `notElem` map prvName revisions-      ]-    revisionGroupMismatch =-      [ mkErr diagnosticLine CatalogExternalReadRevisionGroupMismatch $-          "external-read '"-            <> erName externalRead-            <> "' binds readmodel group '"-            <> queryGroup-            <> "' but compatible revision '"-            <> revisionName-            <> "' belongs to group '"-            <> prvGroup revision-            <> "'"-      | Just queryGroup <- [matchingGroup],-        revisionName <- compatibleRevisions,-        revision <- revisions,-        prvName revision == revisionName,-        prvGroup revision /= queryGroup-      ]-    invalidSurfaceGeneration =-      [ mkErr diagnosticLine CatalogExternalReadSurfaceGenerationInvalid $-          "external-read '" <> erName externalRead <> "' surface-generation must be at least 1"-      | erSurfaceGeneration externalRead <= 0-      ]--validateProjectionOwner :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> ProjectionOwnerNode -> [Diagnostic]-validateProjectionOwner languageContract supplyAnalysis spec owner-  | not (hasProjectionCatalog languageContract) = []-  | otherwise = noSources <> noTargets <> unknownGroup <> outsideGroup <> sourceRules <> identityRules <> checkpointRules <> asyncQueryBinding <> replayRules-  where-    groups = [groupNode | NRebuildGroup groupNode <- specNodes spec]-    targets = [target | NProjectionTarget target <- specNodes spec]-    aggregates = [aggName aggregate | NAggregate aggregate <- specNodes spec]-    selectedGroupTargets = case [rgTargets groupNode | groupNode <- groups, rgName groupNode == poGroup owner] of-      groupTargets : _ -> groupTargets-      [] -> []-    noSources =-      [mkErr (locLine (poLoc owner)) CatalogProjectionNoSource ("projection owner '" <> poName owner <> "' must declare at least one source") | null (poSources owner)]-    noTargets =-      [mkErr (locLine (poLoc owner)) CatalogProjectionNoTarget ("projection owner '" <> poName owner <> "' must declare at least one target") | null (poTargets owner)]-    unknownGroup =-      [ mkErr (locLine (poLoc owner)) CatalogGroupUnknown $-          "projection owner '" <> poName owner <> "' references undeclared rebuild group '" <> poGroup owner <> "'"-      | poGroup owner `notElem` map rgName groups-      ]-    outsideGroup =-      [ mkErr (locLine (poLoc owner)) CatalogProjectionTargetOutsideGroup $-          "projection owner '" <> poName owner <> "' writes target '" <> targetName <> "' outside group '" <> poGroup owner <> "'"-      | targetName <- poTargets owner,-        targetName `notElem` selectedGroupTargets-      ]-    sourceRules =-      [ mkErr (locLine (poLoc owner)) CatalogSourceUnresolved $-          "projection owner '" <> poName owner <> "' references undeclared aggregate source '" <> aggregateName <> "'"-      | CatalogAggregate aggregateName <- poSources owner,-        aggregateName `notElem` aggregates-      ]-        <> [ mkErr (locLine (poLoc owner)) CatalogSourceOverlap $-               "projection owner '" <> poName owner <> "' must select exactly one typed replay source; split independent sources into separate owners"-           | length (poSources owner) > 1-           ]-        <> [ mkErr (locLine (poLoc owner)) RuntimeIdentityInvalid $-               "projection owner '" <> poName owner <> "' category source " <> T.pack (show categoryName) <> " " <> reason-           | CatalogCategory categoryName <- poSources owner,-             Just reason <- [runtimeIdentityError False categoryName]-           ]-    identityRules = case poDelivery owner of-      DeliverySubscription ->-        [ mkErr (locLine (poLoc owner)) CatalogAsyncIdentityMissing $-            "projection owner '" <> poName owner <> "' with subscription delivery requires both subscription and dedup identities"-        | poSubscription owner == Nothing || poDedup owner == Nothing-        ]-      DeliveryInline ->-        [ mkErr (locLine (poLoc owner)) CatalogInlineIdentityUnexpected $-            "projection owner '" <> poName owner <> "' with inline delivery cannot declare subscription or dedup identities"-        | poSubscription owner /= Nothing || poDedup owner /= Nothing-        ]-    checkpointRules = case poDelivery owner of-      DeliverySubscription ->-        [ mkErr (locLine (poLoc owner)) CatalogCheckpointPolicyMissing $-            "projection owner '" <> poName owner <> "' with subscription delivery requires exactly one checkpoint-on-missing policy"-        | null (poCheckpointOnMissing owner)-        ]-          <> [ mkErr (locLine (poLoc owner)) CatalogCheckpointPolicyDuplicate $-                 "projection owner '" <> poName owner <> "' declares checkpoint-on-missing more than once; choose exactly one of from-beginning, from-current-head, or fail"-             | length (poCheckpointOnMissing owner) > 1-             ]-      DeliveryInline ->-        [ mkErr (locLine (poLoc owner)) CatalogCheckpointPolicyUnexpected $-            "projection owner '" <> poName owner <> "' with inline delivery cannot declare checkpoint-on-missing because inline delivery has no durable subscription checkpoint"-        | not (null (poCheckpointOnMissing owner))-        ]-    asyncQueryBinding =-      [ mkErr (locLine (poLoc owner)) CatalogAsyncQueryBindingMissing $-          "projection owner '" <> poName owner <> "' has no query model in group '" <> poGroup owner <> "' observing one of its targets"-      | poDelivery owner == DeliverySubscription,-        null-          [ ()-          | supply <- resolvedProjectionSupplies supplyAnalysis,-            supplyProjectionOwner supply == poName owner-          ]-      ]-    replayRules =-      [ mkErr (locLine (poLoc owner)) CatalogClearTargetLiveOnly $-          "projection owner '" <> poName owner <> "' is live-only but writes a clear-before-replay target"-      | ProjectionLiveOnly _ <- [poReplay owner],-        target <- targets,-        ptName target `elem` poTargets owner,-        ptReset target == TargetClear-      ]-        <> [ mkErr (locLine (poLoc owner)) CatalogCheckpointPolicyReplayUnsafe $-               "projection owner '" <> poName owner <> "' uses from-current-head for subscription '" <> fromMaybe "" (poSubscription owner) <> "' while replayable target '" <> ptName target <> "' is cleared before replay; use from-beginning or fail"-           | poDelivery owner == DeliverySubscription,-             poCheckpointOnMissing owner == [CheckpointFromCurrentHead],-             poReplay owner == ProjectionReplayExplicit,-             target <- targets,-             ptName target `elem` poTargets owner,-             ptReset target == TargetClear-           ]---- | Validate captured identity, feed semantics, and the declared column surface.-validateReadModel :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> ReadModelNode -> [Diagnostic]-validateReadModel languageContract supplyAnalysis spec readModel =-  shapeFixture ++ columnTypes ++ strongFeed ++ scopeMode ++ inlineSubscription ++ inlineReference ++ freshnessCapability ++ versionFloor ++ identifiers ++ runtimeIdentities ++ duplicateColumns ++ catalogBinding-  where-    readModelLine = locLine (rmLoc readModel)-    expectedShape = deriveShapeHash readModel-    shapeFixture =-      [ mkErr readModelLine RmShapeHashDrift $-          "readmodel '"-            <> rmName readModel-            <> "': captured shape \""-            <> rmShape readModel-            <> "\" does not match the declared columns (expected \""-            <> expectedShape-            <> "\"); update the fixture AND bump version if the table shape really changed"-      | rmShape readModel /= expectedShape-      ]-    allowedColumnTypes = Set.fromList ["text", "int", "bigint", "bool", "timestamptz", "jsonb", "numeric"]-    columnTypes =-      [ mkErr readModelLine RmUnknownColumnType $-          "readmodel '" <> rmName readModel <> "' column '" <> rmcName columnDecl <> "' has unknown type '" <> rmcType columnDecl <> "'"-      | columnDecl <- rmColumns readModel,-        rmcType columnDecl `Set.notMember` allowedColumnTypes-      ]-    strongFeed =-      [ mkErr readModelLine RmStrongInlineOnly $-          "readmodel '"-            <> rmName readModel-            <> "': consistency = Strong with feed = inline; an inline-only model has no subscription worker to advance the cursor a Strong read waits on. Use consistency = Eventual, or feed = subscription"-      | legacyReadModelFeed readModel == Just RmInline,-        legacyReadModelConsistency readModel == Just Strong-      ]-    scopeMode =-      [ mkErr readModelLine RmScopeWithoutStrong $-          "readmodel '" <> rmName readModel <> "': scope is meaningful only with consistency = Strong"-      | legacyReadModelScope readModel /= Nothing,-        legacyReadModelConsistency readModel /= Just Strong-      ]-    inlineSubscription =-      [ Diagnostic-          { line = readModelLine,-            severity = Warning,-            code = RmInlineSubscriptionIgnored,-            relatedLocations = [],-            message = "readmodel '" <> rmName readModel <> "': subscription override is ignored when feed = inline; remove it or select feed = subscription"-          }-      | legacyReadModelFeed readModel == Just RmInline,-        legacyReadModelSubscription readModel /= Nothing-      ]-    inlineReference-      | hasProjectionCatalog languageContract,-        rmGroup readModel /= Nothing =-          []-      | otherwise =-          [ mkErr readModelLine RmInlineFeedUnreferenced $-              "readmodel '" <> rmName readModel <> "' declares feed = inline but no aggregate projection references it"-          | legacyReadModelFeed readModel == Just RmInline,-            rmName readModel `notElem` [projTable projection | NAggregate aggregate <- specNodes spec, Just projection <- [aggProjection aggregate]]-          ]-    freshnessCapability-      | not (hasSeparatedProjectionQueryPolicy languageContract) = []-      | otherwise = case rmFreshness readModel of-          FreshnessImmediate -> []-          requested@(FreshnessWaitForHead requestedScope) ->-            case resolvedOwner of-              Nothing-                | not (null implicitProjectionOwners) ->-                    [ waitError-                        CatalogQueryWaitWithoutCompatibleCursor-                        requested-                        "implicit aggregate projection"-                        "inline"-                        []-                        "move the projection into a subscription projection-owner or use freshness = immediate"-                    ]-                | otherwise -> []-              Just owner ->-                case compatibleCursorCandidates requestedScope owner of-                  [] ->-                    [ waitError-                        CatalogQueryWaitWithoutCompatibleCursor-                        requested-                        ("projection-owner '" <> poName owner <> "'")-                        (deliveryText (poDelivery owner))-                        (allCursorCandidates owner)-                        "use freshness = immediate or give the supplying owner one compatible subscription cursor"-                    ]-                  [_] -> []-                  candidates ->-                    [ waitError-                        CatalogQueryWaitWithAmbiguousCursor-                        requested-                        ("projection-owner '" <> poName owner <> "'")-                        (deliveryText (poDelivery owner))-                        candidates-                        "leave exactly one compatible subscription cursor or use freshness = immediate"-                    ]-      where-        resolvedOwner = do-          ownerName <- case [ supplyProjectionOwner supply-                            | supply <- resolvedProjectionSupplies supplyAnalysis,-                              supplyQueryModel supply == rmName readModel-                            ] of-            [name] -> Just name-            _ -> Nothing-          case [owner | NProjectionOwner owner <- specNodes spec, poName owner == ownerName] of-            [owner] -> Just owner-            _ -> Nothing-        implicitProjectionOwners =-          [ aggregate-          | NAggregate aggregate <- specNodes spec,-            Just projection <- [aggProjection aggregate],-            projTable projection == rmName readModel-          ]-        compatibleCursorCandidates scope owner-          | poDelivery owner /= DeliverySubscription = []-          | not (any (sourceReaches scope) (poSources owner)) = []-          | otherwise = allCursorCandidates owner-        allCursorCandidates owner = case poSubscription owner of-          Just subscription -> [subscription]-          Nothing -> []-        sourceReaches RmEntireLog CatalogAll = True-        sourceReaches RmEntireLog _ = False-        sourceReaches (RmCategory _) CatalogAll = True-        sourceReaches (RmCategory wanted) (CatalogCategory actual) = wanted == actual-        sourceReaches (RmCategory wanted) (CatalogAggregate aggregateName) = wanted == lowerInitial aggregateName-        lowerInitial value = case T.uncons value of-          Nothing -> value-          Just (first, rest) -> T.cons (toLower first) rest-        deliveryText DeliveryInline = "inline"-        deliveryText DeliverySubscription = "subscription"-        freshnessText FreshnessImmediate = "immediate"-        freshnessText (FreshnessWaitForHead RmEntireLog) = "wait-for-head entire-log"-        freshnessText (FreshnessWaitForHead (RmCategory category)) = "wait-for-head category " <> T.pack (show category)-        waitError diagnosticCode requested ownerText delivery candidates remedy =-          mkErr readModelLine diagnosticCode $-            "readmodel '"-              <> rmName readModel-              <> "' requests "-              <> freshnessText requested-              <> " but its supplying "-              <> ownerText-              <> " has delivery capabilities "-              <> delivery-              <> " and compatible cursor candidates "-              <> (if null candidates then "none" else T.intercalate ", " (sortOn id candidates))-              <> "; remedy: "-              <> remedy-    versionFloor =-      [ mkErr readModelLine ReadModelVersionBelowMinimum $-          "readmodel '" <> rmName readModel <> "' version must be at least 1"-      | enforcesSpecSurfaceClosures languageContract,-        rmVersion readModel < 1-      ]-    identifiers =-      [ mkErr readModelLine ReadModelIdentifierInvalid $-          "readmodel '" <> rmName readModel <> "' " <> kind <> " " <> T.pack (show identifier) <> " is not a PostgreSQL unquoted identifier"-      | enforcesSpecSurfaceClosures languageContract,-        (kind, identifier) <--          [ (kind, identifier)-          | rmGroup readModel == Nothing,-            (kind, identifier) <- [("schema", rmSchema readModel), ("table", rmTable readModel)]-          ]-            <> [("column", rmcName columnDecl) | columnDecl <- rmColumns readModel],-        not (validPostgresIdentifier identifier)-      ]-    runtimeIdentities =-      [ mkErr readModelLine RuntimeIdentityInvalid $-          "readmodel '" <> rmName readModel <> "' subscription " <> T.pack (show subscription) <> " " <> reason-      | enforcesSpecSurfaceClosures languageContract,-        Just subscription <- [legacyReadModelSubscription readModel],-        Just reason <- [stableIdentityError subscription]-      ]-        ++ [ mkErr readModelLine RuntimeIdentityInvalid $-               "readmodel '" <> rmName readModel <> "' scope category " <> T.pack (show category) <> " " <> reason-           | enforcesSpecSurfaceClosures languageContract,-             Just (RmCategory category) <- [readModelScopeForIdentity readModel],-             Just reason <- [runtimeIdentityError False category]-           ]-    readModelScopeForIdentity model = case rmSupply model of-      LegacyReadModelSupply {legacyScope} -> legacyScope-      OwnerDerivedSupply -> case rmFreshness model of-        FreshnessImmediate -> Nothing-        FreshnessWaitForHead scope -> Just scope-    duplicateColumns =-      [ mkErr readModelLine ReadModelDuplicateColumn $-          "readmodel '" <> rmName readModel <> "' declares column '" <> rmcName columnDecl <> "' more than once"-      | enforcesSpecSurfaceClosures languageContract,-        columnDecl <- duplicatesBy rmcName (rmColumns readModel)-      ]-    catalogBinding-      | not (hasProjectionCatalog languageContract) = []-      | otherwise = missingGroup <> unknownGroup <> physicalOverride <> backingRequired <> backingUnobserved-      where-        groups = [groupNode | NRebuildGroup groupNode <- specNodes spec]-        missingGroup =-          [ mkErr readModelLine CatalogReadModelBindingMissing $-              "readmodel '" <> rmName readModel <> "' must bind to a projection catalog group or be referenced by one legacy aggregate projection"-          | rmGroup readModel == Nothing,-            null-              [ ()-              | NAggregate aggregate <- specNodes spec,-                Just projection <- [aggProjection aggregate],-                projTable projection == rmName readModel-              ]-          ]-        unknownGroup =-          [ mkErr readModelLine CatalogGroupUnknown $-              "readmodel '" <> rmName readModel <> "' references undeclared rebuild group '" <> groupName <> "'"-          | Just groupName <- [rmGroup readModel],-            groupName `notElem` map rgName groups-          ]-        physicalOverride =-          [ mkErr readModelLine CatalogReadModelPhysicalOverride $-              "readmodel '"-                <> rmName readModel-                <> "' binds to group '"-                <> groupName-                <> "' but declares explicit table/schema; physical coordinates belong to the target declaration — remove table/schema and name the intended target in 'targets' (and 'backing' when observing several)"-          | Just groupName <- [rmGroup readModel],-            rmTable readModel /= "" || rmSchema readModel /= ""-          ]-        backingRequired =-          [ mkErr readModelLine CatalogReadModelBackingRequired $-              "readmodel '"-                <> rmName readModel-                <> "' observes "-                <> T.pack (show (length (rmObservedTargets readModel)))-                <> " targets; name the physical backing target with 'backing = <target>'"-          | rmGroup readModel /= Nothing,-            length (rmObservedTargets readModel) > 1,-            rmBackingTarget readModel == Nothing-          ]-        backingUnobserved =-          [ mkErr readModelLine CatalogReadModelBackingUnobserved $-              "readmodel '"-                <> rmName readModel-                <> "' names backing target '"-                <> backingTarget-                <> "' but does not observe it"-          | Just backingTarget <- [rmBackingTarget readModel],-            backingTarget `notElem` rmObservedTargets readModel-          ]---- | EP-5 workqueue rules: the captured physical name must match the queueRef--- derivation; the disposition inversions (storeFailure transient => must retry;--- decodeFailure poison => must dead-letter); and dlq=on requires a retry ceiling.-validateWorkqueue :: EffectiveLanguageContract -> WorkqueueNode -> [Diagnostic]-validateWorkqueue languageContract w = concat [divergence, completeness, duplicateRows, inversions, retryCeiling, orderingRules, groupKeyRules, payloadTypes, windows, provisionRules]-  where-    wl = locLine (wqLoc w)-    rows = wqDisposition w-    (derivedPhysical, derivedDlq, derivedTable) = derivedQueueTrio (wqLogical w)-    divergence =-      [ mkErr wl WqPhysicalDivergence $-          "workqueue '" <> wqName w <> "': captured physical \"" <> wqPhysical w <> "\" diverges from queueRef(\"" <> wqLogical w <> "\") = \"" <> derivedPhysical <> "\""-      | wqPhysical w /= derivedPhysical-      ]-        ++ [ mkErr wl WqDlqDivergence $-               "workqueue '" <> wqName w <> "': captured dlq \"" <> wqDlq w <> "\" diverges from queueRef = \"" <> derivedDlq <> "\""-           | wqDlq w /= derivedDlq-           ]-        ++ [ mkErr wl WqTableDivergence $-               "workqueue '" <> wqName w <> "': captured table \"" <> wqTable w <> "\" diverges from queueRef table = \"" <> derivedTable <> "\""-           | wqTable w /= derivedTable-           ]-    requiredOutcomes = ["storeFailure", "commandRejected", "decodeFailure", "onCodecReject"]-    completeness =-      [ mkErr wl WqDispositionIncomplete $-          "workqueue '" <> wqName w <> "' disposition table is missing outcome '" <> outcome <> "'"-      | outcome <- requiredOutcomes,-        outcome `notElem` map wqdOutcome rows-      ]-    duplicateRows =-      [ mkErr (locLine (wqdLoc row)) DispositionDuplicateOutcome $-          "workqueue '" <> wqName w <> "' repeats disposition outcome '" <> wqdOutcome row <> "'; the first row would shadow this row"-      | row <- duplicatesBy wqdOutcome rows-      ]-    firstRow outcome = case [row | row <- rows, wqdOutcome row == outcome] of-      (row : _) -> Just row-      [] -> Nothing-    isRetry row = case wqdAction row of IRetry _ -> True; _ -> False-    isDeadLetter row = case wqdAction row of IDeadLetter _ -> True; _ -> False-    inversions =-      [ mkErr (locLine (wqdLoc row)) WqStoreFailureNotRetry ("workqueue '" <> wqName w <> "': 'storeFailure' is transient and MUST retry, not dead-letter")-      | Just row <- [firstRow "storeFailure"],-        isDeadLetter row-      ]-        ++ [ mkErr (locLine (wqdLoc row)) WqDecodeFailureNotDeadLetter ("workqueue '" <> wqName w <> "': 'decodeFailure' is poison and MUST dead-letter, not retry")-           | Just row <- [firstRow "decodeFailure"],-             isRetry row-           ]-    retryCeiling =-      [ mkErr wl WqDlqWithoutCeiling ("workqueue '" <> wqName w <> "': dlq=on requires maxRetries >= 1 (an absent ceiling never dead-letters)")-      | wqDlqOn w && wqMaxRetries w < 1-      ]-    fifo = wqOrdering w /= WqUnordered-    orderingRules =-      [ mkErr wl WqGroupKeyMissing $-          "workqueue '" <> wqName w <> "': FIFO delivery is per group, so ordering requires a 'group key' clause that makes enqueueToGroup deterministic"-      | fifo && wqGroupKey w == Nothing-      ]-        ++ [ mkErr wl WqGroupKeyWithoutFifo $-               "workqueue '" <> wqName w <> "': a group key with unordered reads would be ignored; declare a FIFO ordering or remove the key"-           | not fifo && wqGroupKey w /= Nothing-           ]-    groupKeyRules = case wqGroupKey w of-      Nothing -> []-      Just groupKey ->-        case [field | field <- wqPayload w, wqfName field == gkField groupKey] of-          [] ->-            [ mkErr wl WqGroupKeyUnresolved $-                "workqueue '" <> wqName w <> "': group key field '" <> gkField groupKey <> "' is not declared in its payload"-            ]-          field : _ ->-            [ mkErr wl WqGroupKeyUnresolved $-                "workqueue '" <> wqName w <> "': group key via raw requires a text payload field, but '" <> gkField groupKey <> "' has type '" <> queuePayloadTypeText (wqfType field) <> "'"-            | gkVia groupKey == "raw" && not (isDirectText (wqfType field))-            ]-              ++ [ mkErr wl WqGroupKeyUnresolved $-                     "workqueue '" <> wqName w <> "': opaque group-key derivation '" <> gkVia groupKey <> "' requires a captured fixture"-                 | gkVia groupKey /= "raw" && gkFixture groupKey == Nothing-                 ]-    payloadTypes =-      [ mkErr wl WqPayloadTypeUnknown $-          "workqueue '" <> wqName w <> "' payload field '" <> wqfName field <> "' has unknown type '" <> queueScalarName scalar <> "'; expected text, int, or bool"-      | enforcesSpecSurfaceClosures languageContract,-        field <- wqPayload w,-        LegacyQueueScalar scalar@(QueueOther _) <- [wqfType field]-      ]-    isDirectText (LegacyQueueScalar QueueText) = True-    isDirectText (TypedQueueExpression TText) = True-    isDirectText _ = False-    queuePayloadTypeText (LegacyQueueScalar scalar) = queueScalarName scalar-    queuePayloadTypeText (TypedQueueExpression _) = "mapped expression"-    windows =-      windowRangeRule languageContract wl ("workqueue '" <> wqName w <> "' delay") (wqDelay w)-        ++ concat-          [ windowRangeRule languageContract (locLine (wqdLoc row)) ("workqueue '" <> wqName w <> "' retry") window-          | row <- rows,-            IRetry window <- [wqdAction row]-          ]-    provisionRules = case wqProvision w of-      WqStandard -> []-      WqUnlogged ->-        [ Diagnostic-            { line = wl,-              severity = Warning,-              code = WqUnloggedDurability,-              relatedLocations = [],-              message = "workqueue '" <> wqName w <> "': provision unlogged is truncated to empty on a database crash; use it only for transient, regenerable work"-            }-        ]-      WqPartitioned interval retention ->-        [ mkErr wl WqPartitionSpecEmpty $-            "workqueue '" <> wqName w <> "': partition interval and retention must be non-empty; they are create-time settings and the additive reconciler will not migrate an existing queue"-        | T.null interval || T.null retention-        ]---- | EP-5 dispatch rule: the @enqueue to@ target must resolve to a declared workqueue.-validatePgmqDispatch :: EffectiveLanguageContract -> Spec -> PgmqDispatchNode -> [Diagnostic]-validatePgmqDispatch languageContract spec d = enqueueRef ++ dedupQueueRef ++ sourceReadModelRef ++ sourceReadModelField ++ dedupReadModelRef ++ dedupReadModelField ++ dedupKeyField ++ fanoutFunctionName-  where-    dl = locLine (pdLoc d)-    -- The top-level `dedup key` is the logical value being deduped. Its two-    -- physical locations are already checked against the seenIn read model and-    -- queue; the key itself comes from the source read model's row, so it must-    -- be one of that model's generated selectors — exactly the rule `source key`-    -- already obeys. ExecPlan 197 parked this as descriptive-only.-    dedupKeyField = case [readModel | NReadModel readModel <- specNodes spec, rmName readModel == pdSourceReadModel d] of-      [] -> []-      readModel : _ ->-        [ mkSurfaceRefusal languageContract dl DispatchReadModelFieldUnknown $-            "dispatch '"-              <> pdName d-              <> "' dedup key '"-              <> pdDedupKey d-              <> "' is not a generated logical selector for a column of source readmodel '"-              <> pdSourceReadModel d-              <> "'"-        | pdDedupKey d `notElem` map (logicalFieldSelector . rmcName) (rmColumns readModel)-        ]--    -- `fanout body` names a hand-written function that expands one source row-    -- into queued jobs. A pgmq dispatch generates no module, so there is no-    -- typed namespace to resolve the name against — but a name that is not a-    -- legal Haskell value identifier cannot be the name of any function anyone-    -- could write, which is decidable here. ExecPlan 197 parked this too.-    fanoutFunctionName =-      [ mkSurfaceRefusal languageContract dl PgmqFanoutFunctionInvalid $-          "dispatch '"-            <> pdName d-            <> "' fanout body '"-            <> pdFanoutBody d-            <> "' cannot name a Haskell function; it must be a lowercase-initial identifier that is not a reserved word"-      | not (lowerIdentifierSafe (pdFanoutBody d))-      ]-    workqueues = [w | NWorkqueue w <- specNodes spec]-    enqueueRef =-      [ mkErr dl DispatchEnqueueUnresolved ("dispatch '" <> pdName d <> "' enqueues to undeclared workqueue '" <> pdEnqueueTo d <> "'")-      | pdEnqueueTo d `notElem` map wqName workqueues-      ]-    dedupQueueRef = case [w | w <- workqueues, wqName w == pdDedupQueue d] of-      [] ->-        [ mkErr dl DispatchDedupQueueUnresolved $-            "dispatch '" <> pdName d <> "' checks an undeclared dedup queue '" <> pdDedupQueue d <> "'"-        ]-      (queue : _) ->-        [ mkErr dl DispatchDedupFieldUnresolved $-            "dispatch '" <> pdName d <> "' dedup field '" <> pdDedupQueueField d <> "' is not a payload wire field of queue '" <> pdDedupQueue d <> "'"-        | pdDedupQueueField d `notElem` map wqfWire (wqPayload queue)-        ]-    sourceReadModelRef =-      resolveReadModelRef DispatchReadModelUnresolved spec (pdLoc d) ("dispatch '" <> pdName d <> "' source") (pdSourceReadModel d)-    sourceReadModelField = case [readModel | NReadModel readModel <- specNodes spec, rmName readModel == pdSourceReadModel d] of-      [] -> []-      readModel : _ ->-        [ mkErr dl DispatchReadModelFieldUnknown $-            "dispatch '" <> pdName d <> "' source key '" <> pdSourceKey d <> "' is not a generated logical selector for a column of readmodel '" <> pdSourceReadModel d <> "'"-        | enforcesSpecSurfaceClosures languageContract,-          pdSourceKey d `notElem` map (logicalFieldSelector . rmcName) (rmColumns readModel)-        ]-    dedupReadModelRef =-      resolveReadModelRef DispatchReadModelUnresolved spec (pdLoc d) ("dispatch '" <> pdName d <> "' dedup") (pdDedupReadModel d)-    dedupReadModelField = case [readModel | NReadModel readModel <- specNodes spec, rmName readModel == pdDedupReadModel d] of-      [] -> []-      (readModel : _) ->-        [ mkErr dl DispatchReadModelFieldUnknown $-            "dispatch '" <> pdName d <> "' dedup field '" <> pdDedupReadModelField d <> "' is not a declared column of readmodel '" <> pdDedupReadModel d <> "'"-        | pdDedupReadModelField d `notElem` map rmcName (rmColumns readModel)-        ]---- | The declared contracts in a spec, by name.-specContracts :: Spec -> [ContractNode]-specContracts spec = [c | NContract c <- specNodes spec]---- | EP-4 cross-node coupling: an intake's contract/topic/accepted-events resolve.-intakeCoupling :: EffectiveLanguageContract -> Spec -> IntakeNode -> [Diagnostic]-intakeCoupling languageContract spec i = bindFlagWarnings ++ bindHeaderNames ++ contractCoupling-  where-    -- The Kafka inbox reconstructs an envelope from the canonical header names-    -- in "Keiro.Integration.Event"; nothing reads a spec-declared header. A row-    -- naming a canonical header is descriptive and true, so it stays silent. A-    -- row naming any other header reads like remapping and silently is not.-    bindHeaderNames =-      [ mkSurfaceRefusal languageContract (locLine (inkLoc i)) IntakeBindHeaderUnknown $-          "intake '"-            <> inkName i-            <> "' binds '"-            <> brField binding-            <> "' from header "-            <> T.pack (show headerName)-            <> ", which is not one of keiro's canonical envelope headers; the Kafka inbox reads a fixed header set and cannot be remapped, so this row would not take effect. Use one of: "-            <> T.intercalate ", " (map (T.pack . show) canonicalEnvelopeHeaders)-      | binding <- inkBinds i,-        SrcHeader headerName <- [brSource binding],-        headerName `notElem` canonicalEnvelopeHeaders-      ]-    contractCoupling = case lookupContract (inkContract i) of-      Nothing ->-        [mkErr (locLine (inkLoc i)) IntakeUnresolvedContract ("intake '" <> inkName i <> "' references undeclared contract '" <> inkContract i <> "'")]-      Just c ->-        concat-          [ [ mkErr (locLine (inkLoc i)) IntakeUnresolvedContract ("intake '" <> inkName i <> "' topic '" <> inkTopic i <> "' is not a topic of contract '" <> inkContract i <> "'")-            | inkTopic i `notElem` map fst (ctrTopics c)-            ],-            [ mkErr (locLine (inkLoc i)) IntakeUnresolvedContract ("intake '" <> inkName i <> "' accepts event '" <> ev <> "' not declared in contract '" <> inkContract i <> "'")-            | ev <- inkAccept i,-              ev `notElem` map ceName (ctrEvents c)-            ],-            [ mkErr (locLine (inkLoc i)) TopicAffinityMismatch $-                "intake '" <> inkName i <> "' subscribes to topic '" <> inkTopic i <> "' but accepted event '" <> ceName event <> "' is declared on topic '" <> ceTopic event <> "'"-            | event <- ctrEvents c,-              ceName event `elem` inkAccept i,-              ceTopic event /= inkTopic i-            ],-            [ mkErr (locLine (inkLoc i)) IntakeBindUnresolved $-                "intake '" <> inkName i <> "' binds undeclared envelope or accepted-event field '" <> brField binding <> "'"-            | enforcesSpecSurfaceClosures languageContract,-              binding <- inkBinds i,-              brField binding `Set.notMember` resolvableFields c-            ],-            [ mkErr (locLine (inkLoc i)) IntakeDedupeKeyUnresolved $-                "intake '" <> inkName i <> "' dedupe key '" <> inkDedupeKey i <> "' is not an envelope or accepted-event field"-            | enforcesSpecSurfaceClosures languageContract,-              inkDedupeKey i `Set.notMember` resolvableFields c-            ],-            [ mkErr (locLine (inkLoc i)) IntakeDecodeSchemaVersionMismatch $-                "intake '"-                  <> inkName i-                  <> "' decode schemaVersion "-                  <> tInt (decBodySchemaVersion (inkDecode i))-                  <> " does not match contract '"-                  <> ctrName c-                  <> "' schemaVersion "-                  <> tInt (ctrSchemaVersion c)-            | enforcesSpecSurfaceClosures languageContract,-              decBodySchemaVersion (inkDecode i) /= ctrSchemaVersion c-            ]-          ]-    bindFlagWarnings =-      [ Diagnostic-          { line = locLine (inkLoc i),-            severity = Warning,-            code = IntakeBindFlagUnenforced,-            relatedLocations = [],-            message =-              "intake '"-                <> inkName i-                <> "' bind for '"-                <> brField binding-                <> "' declares "-                <> bindFlagText binding-                <> ", but generated code does not consume envelope bindings"-          }-      | binding <- inkBinds i,-        brRequired binding || brCrossCheck binding-      ]-    lookupContract n = case [c | c <- specContracts spec, ctrName c == n] of (c : _) -> Just c; [] -> Nothing-    resolvableFields contract =-      canonicalIntakeEnvelopeFields-        <> Set.fromList-          [ cfName field-          | event <- ctrEvents contract,-            ceName event `elem` inkAccept i,-            field <- ceFields event-          ]-    bindFlagText binding = case (brRequired binding, brCrossCheck binding) of-      (True, True) -> "'required' and 'cross-check body' flags"-      (True, False) -> "a 'required' flag"-      (False, True) -> "a 'cross-check body' flag"-      (False, False) -> "no enforcement flags"---- Note: @derive … hole@ is mandatory emit grammar, so a per-emit warning about--- it would fire on every emit node in every spec and carry no information. The--- fact that an emit generates no module is reported once, per scaffold run, by--- the report's inert-node line. See ExecPlan 199.-validateEmit :: EffectiveLanguageContract -> Spec -> EmitNode -> [Diagnostic]-validateEmit languageContract spec e = skipRule ++ duplicateCases ++ coupling-  where-    el = locLine (emLoc e)-    skipRule =-      [ mkErr el EmitSkipMissing ("emit '" <> emName e <> "' map must end with an explicit '_ => skip' catch-all (hole-kind 7 optionality)")-      | not (emSkip e)-      ]-    duplicateCases =-      [ mkErr (locLine (emrLoc row)) EmitMapDuplicateCase $-          "emit '" <> emName e <> "' repeats map discriminant '" <> emrValue row <> "'; the first row would shadow this row"-      | enforcesSpecSurfaceClosures languageContract,-        row <- duplicatesBy emrValue (emMap e)-      ]-    coupling = case [c | c <- specContracts spec, ctrName c == emContract e] of-      [] -> [mkErr el EmitUnresolvedContract ("emit '" <> emName e <> "' references undeclared contract '" <> emContract e <> "'")]-      (c : _) ->-        [ mkErr el EmitUnresolvedContract ("emit '" <> emName e <> "' topic '" <> emTopic e <> "' is not a topic of contract '" <> emContract e <> "'")-        | emTopic e `notElem` map fst (ctrTopics c)-        ]-          ++ [ mkErr (locLine (emrLoc r)) EmitUnresolvedContract ("emit '" <> emName e <> "' maps to event '" <> emrEvent r <> "' not declared in contract '" <> emContract e <> "'")-             | r <- emMap e,-               emrEvent r `notElem` map ceName (ctrEvents c)-             ]-          ++ [ mkErr (locLine (emrLoc row)) TopicAffinityMismatch $-                 "emit '" <> emName e <> "' publishes on topic '" <> emTopic e <> "' but mapped event '" <> emrEvent row <> "' is declared on topic '" <> ceTopic event <> "'"-             | row <- emMap e,-               event <- ctrEvents c,-               ceName event == emrEvent row,-               ceTopic event /= emTopic e-             ]--validatePublisher :: EffectiveLanguageContract -> Spec -> PublisherNode -> [Diagnostic]-validatePublisher languageContract spec p =-  unresolvedEmit ++ orderingVocabulary ++ backoffPolicy ++ attemptsFloor ++ outboxField ++ windows-  where-    publisherLine = locLine (pubLoc p)-    unresolvedEmit =-      [ mkErr publisherLine PublisherUnresolvedEmit ("publisher '" <> pubName p <> "' references undeclared emit '" <> pubEmit p <> "'")-      | pubEmit p `notElem` [emName e | NEmit e <- specNodes spec]-      ]-    orderingVocabulary =-      [ mkErr publisherLine PublisherOrderingUnknown $-          "publisher '"-            <> pubName p-            <> "' has unknown ordering '"-            <> pubOrdering p-            <> "'; expected PerKeyHeadOfLine, PerSourceStream, StopTheLine, or BestEffort"-      | pubOrdering p `Set.notMember` publisherOrderings-      ]-    backoffPolicy =-      [ mkErr publisherLine PublisherBackoffInvalid $-          "publisher '" <> pubName p <> "' has an invalid " <> problem-      | Just problem <- [backoffProblemMaybe (pubBackoff p)]-      ]-    attemptsFloor =-      [ mkErr publisherLine PublisherMaxAttemptsBelowMinimum $-          "publisher '" <> pubName p <> "' maxAttempts must be at least 1"-      | enforcesSpecSurfaceClosures languageContract,-        pubMaxAttempts p < 1-      ]-    outboxField = case [emitNode | NEmit emitNode <- specNodes spec, emName emitNode == pubEmit p] of-      [] -> []-      emitNode : _ ->-        [ mkErr publisherLine PublisherOutboxFieldUnresolved $-            "publisher '" <> pubName p <> "' outboxId field '" <> pubOutboxField p <> "' is not messageId, idempotencyKey, or a field of an event mapped by emit '" <> pubEmit p <> "'"-        | enforcesSpecSurfaceClosures languageContract,-          pubOutboxField p `Set.notMember` allowedOutboxFields emitNode-        ]-    allowedOutboxFields emitNode =-      Set.fromList ("messageId" : "idempotencyKey" : mappedContractFields emitNode)-    mappedContractFields emitNode =-      [ fieldDslName (resolveContractFieldIdentity field)-      | contract <- specContracts spec,-        ctrName contract == emContract emitNode,-        event <- ctrEvents contract,-        ceName event `elem` map emrEvent (emMap emitNode),-        field <- ceFields event-      ]-    windows =-      windowRangeRule languageContract publisherLine ("publisher '" <> pubName p <> "' backoff") (boWindow (pubBackoff p))-        ++ maybe [] (windowRangeRule languageContract publisherLine ("publisher '" <> pubName p <> "' maximum backoff")) (boMax (pubBackoff p))--publisherOrderings :: Set Name-publisherOrderings = Set.fromList ["PerKeyHeadOfLine", "PerSourceStream", "StopTheLine", "BestEffort"]--backoffProblemMaybe :: BackoffSpec -> Maybe Text-backoffProblemMaybe backoff = case boKind backoff of-  "constant" -> Nothing-  "exponential" -> case (boMax backoff, boMultiplier backoff) of-    (Just maximumWindow, Just multiplierText) ->-      case (validationWindowSeconds (boWindow backoff), validationWindowSeconds maximumWindow, readMaybe (T.unpack multiplierText) :: Maybe Double) of-        (Just initialSeconds, Just maximumSeconds, Just multiplier)-          | initialSeconds > 0 && maximumSeconds >= initialSeconds && multiplier >= 1 -> Nothing-        _ -> Just "exponential backoff; initial must be positive, max must be at least initial, and multiplier must be at least 1"-    _ -> Just "exponential backoff; both max and multiplier are required"-  other -> Just ("backoff kind '" <> other <> "'; expected constant or exponential")--validationWindowSeconds :: Text -> Maybe Int-validationWindowSeconds window = case T.unsnoc window of-  Just (digits, unit) -> do-    amount <- readMaybe (T.unpack digits)-    case unit of-      's' -> Just amount-      'm' -> Just (amount * 60)-      'h' -> Just (amount * 3600)-      _ -> Nothing-  Nothing -> Nothing--windowSecondsBounded :: Text -> Either Text Int-windowSecondsBounded window = case T.unsnoc window of-  Nothing -> Left "has no unit"-  Just (digits, unit) -> case readMaybe (T.unpack digits) :: Maybe Integer of-    Nothing -> Left "has invalid digits"-    Just amount -> case unitFactor unit of-      Nothing -> Left "has an unknown unit"-      Just factor-        | seconds > fromIntegral (maxBound :: Int) -> Left "exceeds the runtime Int seconds range"-        | otherwise -> Right (fromIntegral seconds)-        where-          seconds = amount * factor-  where-    unitFactor 's' = Just 1-    unitFactor 'm' = Just 60-    unitFactor 'h' = Just 3600-    unitFactor _ = Nothing--windowRangeRule :: EffectiveLanguageContract -> Int -> Text -> Text -> [Diagnostic]-windowRangeRule languageContract diagnosticLine context window =-  [ mkErr diagnosticLine WindowOutOfRange $-      context <> " window '" <> window <> "' " <> reason-  | enforcesSpecSurfaceClosures languageContract,-    Left reason <- [windowSecondsBounded window]-  ]---- | EP-4 inbox disposition rules: the table must be complete over the seven--- outcomes, and the three dangerous inversions must be stated the safe way.-validateIntake :: EffectiveLanguageContract -> IntakeNode -> [Diagnostic]-validateIntake languageContract i = concat [completeness, duplicateRows, inversions, dedupeVocabulary, decodeVersionFloor, envelopeVocabulary, decodePosture, windows]-  where-    il = locLine (inkLoc i)-    -- `decBodyStrict` reaches nothing but the pretty-printer: generated contract-    -- codecs decode every declared body field as required and admit no lenient-    -- mode, so `body strict` describes what happens and `body lenient` does not.-    decodePosture =-      [ mkSurfaceRefusal languageContract il DecodeBodyPostureUnsupported $-          "intake '"-            <> inkName i-            <> "' declares 'body lenient', but generated contract codecs decode a body strictly: every declared field is required and no lenient fallback is emitted. Write 'body strict' to describe what runs"-      | not (decBodyStrict (inkDecode i))-      ]-    rows = inkDisposition i-    requiredOutcomes =-      ["processed", "duplicate", "inProgress", "previouslyFailed", "decodeFailed", "dedupeFailed", "storeFailed"]-    completeness =-      [ mkErr il DispositionIncomplete $-          "intake '" <> inkName i <> "' disposition table is missing outcome '" <> o <> "'"-      | o <- requiredOutcomes,-        o `notElem` map drOutcome rows-      ]-    duplicateRows =-      [ mkErr (locLine (drLoc row)) DispositionDuplicateOutcome $-          "intake '" <> inkName i <> "' repeats disposition outcome '" <> drOutcome row <> "'; the first row would shadow this row"-      | row <- duplicatesBy drOutcome rows-      ]-    windows =-      concat-        [ windowRangeRule languageContract (locLine (drLoc row)) ("intake '" <> inkName i <> "' retry") window-        | row <- rows,-          IRetry window <- [drAction row]-        ]-    dedupeVocabulary =-      [ mkErr il IntakeDedupePolicyUnknown $-          "intake '"-            <> inkName i-            <> "' has unknown dedupe policy '"-            <> inkDedupePolicy i-            <> "'; expected PreferIntegrationMessageId, PreferSourceEventIdentity, or KafkaDeliveryIdentity"-      | inkDedupePolicy i `Set.notMember` intakeDedupePolicies-      ]-    decodeVersionFloor =-      [ mkErr il IntakeDecodeSchemaVersionBelowMinimum $-          "intake '" <> inkName i <> "' decode schemaVersion must be at least 1"-      | enforcesSpecSurfaceClosures languageContract,-        decBodySchemaVersion (inkDecode i) < 1-      ]-    envelopeVocabulary =-      [ mkErr il IntakeEnvelopePolicyUnknown $-          "intake '" <> inkName i <> "' has unsupported envelope policy " <> T.pack (show (decEnvelope (inkDecode i))) <> "; expected \"strict-required lenient-optional\""-      | enforcesSpecSurfaceClosures languageContract,-        decEnvelope (inkDecode i) /= "strict-required lenient-optional"-      ]-    firstRow outcome = case [row | row <- rows, drOutcome row == outcome] of-      (row : _) -> Just row-      [] -> Nothing-    isRetry row = case drAction row of IRetry _ -> True; _ -> False-    inversions =-      [ mkErr (locLine (drLoc row)) DispositionDuplicateRetry $-          "intake '" <> inkName i <> "': a 'duplicate' redelivery must be ackOk (success), not retry"-      | Just row <- [firstRow "duplicate"],-        isRetry row-      ]-        ++ [ mkErr (locLine (drLoc row)) DispositionPreviouslyFailedRetry $-               "intake '" <> inkName i <> "': 'previouslyFailed' must dead-letter, not retry (a prior failure won't succeed on replay)"-           | Just row <- [firstRow "previouslyFailed"],-             isRetry row-           ]-        ++ [ mkErr (locLine (drLoc row)) DispositionDecodeUnboundedRetry $-               "intake '" <> inkName i <> "': 'decodeFailed' must dead-letter (terminal), not retry unboundedly"-           | Just row <- [firstRow "decodeFailed"],-             isRetry row-           ]--intakeDedupePolicies :: Set Name-intakeDedupePolicies = Set.fromList ["PreferIntegrationMessageId", "PreferSourceEventIdentity", "KafkaDeliveryIdentity"]---- | The timer statuses a stored row can hold, mirroring @TimerStatus@ in--- @keiro@'s "Keiro.Timer.Schema". keiro-dsl deliberately does not depend on the--- runtime package, so the list is restated here; the conformance suite that does--- depend on @keiro@ asserts the two agree.-runtimeTimerStatuses :: [Text]-runtimeTimerStatuses = ["Scheduled", "Firing", "Fired", "Cancelled", "Dead"]---- | Every header name keiro's integration envelope actually uses on the wire,--- taken from the runtime's own definitions in "Keiro.Integration.Event" rather--- than restated here, so the two cannot drift apart.-canonicalEnvelopeHeaders :: [Text]-canonicalEnvelopeHeaders =-  [ Event.headerMessageId,-    Event.headerSource,-    Event.headerDestination,-    Event.headerEventType,-    Event.headerSchemaVersion,-    Event.headerContentType,-    Event.headerSchemaRegistry,-    Event.headerSchemaSubject,-    Event.headerSchemaVersionRef,-    Event.headerSchemaId,-    Event.headerSchemaFingerprint,-    Event.headerSourceEventId,-    Event.headerSourceGlobalPosition,-    Event.headerCausationId,-    Event.headerCorrelationId,-    Event.headerTraceParent,-    Event.headerTraceState,-    Event.headerOccurredAt,-    Event.headerAttributes-  ]--canonicalIntakeEnvelopeFields :: Set Name-canonicalIntakeEnvelopeFields =-  Set.fromList-    [ "messageId",-      "source",-      "destination",-      "key",-      "eventType",-      "schemaVersion",-      "contentType",-      "schemaReference",-      "sourceEventId",-      "sourceGlobalPosition",-      "payloadBytes",-      "occurredAt",-      "causationId",-      "correlationId",-      "traceContext",-      "attributes",-      "idempotencyKey"-    ]---- | EP-3 rules for a process manager + its nested timer.-validateProcess :: EffectiveLanguageContract -> Spec -> ProcessNode -> [Diagnostic]-validateProcess languageContract spec p =-  concat [sagaCategoryRule, noWallClock, runtimeOwnedDispatchId, crossNodeCoupling, strictSurfaceResolution, timerCeiling, policyRules, ambiguityRule, benignInversions, onAppendedArms, notMineArm, decodeUnknownStatus, deadLetterText]-  where-    -- Generated dispatch code appends and then acks; `Keiro.ProcessManager` has-    -- no branch that retries or dead-letters a *successful* append. Only AckOk-    -- describes what runs.-    onAppendedArms =-      [ mkSurfaceRefusal languageContract (locLine (dispLoc d)) DispatchOnAppendedUnsupported $-          "dispatch to '"-            <> dispTarget d-            <> "' maps on-appended => "-            <> dispText (onAppended (dispDisposition d))-            <> ", but a successful append is always acked: no runtime path retries or dead-letters an event it just appended. Write 'on-appended AckOk'"-      | d <- hDispatch (procHandle p),-        onAppended (dispDisposition d) /= DAckOk-      ]--    -- `decode unknown-status => X` names the status a row that fails to decode-    -- is read as. X must be a status the timer table actually has.-    decodeUnknownStatus =-      [ mkSurfaceRefusal languageContract (locLine (tmLoc timer)) TimerDecodeStatusUnknown $-          "timer '"-            <> tmName timer-            <> "' maps decode unknown-status => '"-            <> tmDecodeUnknown timer-            <> "', which is not a timer status; a stored timer row is one of: "-            <> T.intercalate ", " runtimeTimerStatuses-      | tmDecodeUnknown timer `notElem` runtimeTimerStatuses-      ]--    -- The dead-letter reason is a hand-owned obligation: `runTimerWorkerWith`-    -- composes its own message for the attempt ceiling, and the generated-    -- comment surfaces this text so an operator-written worker can pass it to-    -- `Keiro.Timer.deadLetterTimer`. Nothing can check what the prose says, but-    -- an empty or blank reason names no obligation at all.-    deadLetterText =-      [ mkSurfaceRefusal languageContract (locLine (tmLoc timer)) TimerDeadLetterTextInvalid $-          "timer '"-            <> tmName timer-            <> "' declares a blank dead-letter reason; the reason is the hand-owned text an operator-written timer worker passes to Keiro.Timer.deadLetterTimer, so it must say something"-      | T.null (T.strip (tmDeadLetter timer))-      ]--    -- The timer worker marks a timer Fired only when the fire action returns the-    -- id of an event it appended (`Keiro.Timer.runTimerWorkerWith`). A not-mine-    -- dispatch produces no such id, so the row is left Firing and requeued on a-    -- later pass — which is exactly Retry. Fired is not reachable.-    notMineArm =-      [ mkSurfaceRefusal languageContract (locLine (tmLoc timer)) TimerNotMineUnsupported $-          "timer '"-            <> tmName timer-            <> "' maps not-mine => Fired, but the timer worker marks a timer Fired only when the fire action returns the id of the event it appended; a dispatch that is not this timer's has no such id, so the row is requeued instead. Write 'not-mine Retry'"-      | notMine (fireDisposition (tmFire timer)) == OFired-      ]-    aggregates = [a | NAggregate a <- specNodes spec]-    aggNames = map aggName aggregates-    projectionTables = [projTable projection | aggregate <- aggregates, Just projection <- [aggProjection aggregate]]-    inputFields = map fieldName (inFields (procInput p))-    timeFields = [fieldName f | f <- inFields (procInput p), fieldType f == Just "Time"]-    timer = procTimer p-    pl = locLine (procLoc p)--    sagaCategoryRule =-      [ mkErr pl SagaCategoryIllegal $-          "saga category " <> T.pack (show (sagaCategory (procSaga p))) <> " " <> reason-      | Just reason <- [sagaCategoryError (sagaCategory (procSaga p))]-      ]--    -- TIME IS INJECTED, NOT SAMPLED: fireAt's field must be a declared :Time-    -- input field. (FireAtExpr has no clock-sampling constructor, so this is a-    -- field-resolution + typed-as-Time check.)-    noWallClock =-      let f = faField (tmFireAt timer)-       in if f `notElem` inputFields-            then-              [ mkErr (locLine (tmLoc timer)) ProcessFireAtNotInjected $-                  "timer '" <> tmName timer <> "' fireAt field '" <> f <> "' is not a field of input '" <> inName (procInput p) <> "'"-              ]-            else-              [ mkErr (locLine (tmLoc timer)) ProcessFireAtNotInjected $-                  "timer '" <> tmName timer <> "' fireAt references '" <> f <> "', which is not a declared :Time field of input '" <> inName (procInput p) <> "'"-              | f `notElem` timeFields-              ]--    -- Dispatched (and fired) command ids are runtime-owned; no field binding may-    -- supply a commandId/id.-    runtimeOwnedDispatchId =-      [ mkErr pl ProcessDispatchIdSupplied $-          "advance command '" <> advCommand advance <> "' supplies a runtime-owned id field '" <> fbName binding <> "'; remove it"-      | let advance = hAdvance (procHandle p),-        binding <- advFields advance,-        fbName binding `elem` (["commandId", "id"] :: [Name])-      ]-        ++ [ mkErr (locLine (dispLoc d)) ProcessDispatchIdSupplied $-               "dispatch to '" <> dispTarget d <> "' supplies a runtime-owned id field '" <> fbName b <> "'; remove it"-           | d <- hDispatch (procHandle p),-             b <- dispFields d,-             fbName b `elem` (["commandId", "id"] :: [Name])-           ]-        ++ [ mkErr (locLine (tmLoc timer)) ProcessDispatchIdSupplied $-               "timer fire supplies a runtime-owned id field '" <> fbName b <> "'; remove it"-           | b <- fireFields (tmFire timer),-             fbName b `elem` (["commandId", "id"] :: [Name])-           ]--    -- Aggregate, command, field, timer, and projection references must resolve.-    crossNodeCoupling =-      [ mkErr pl ProcessUnresolvedRef ("saga '" <> sagaAgg (procSaga p) <> "' does not resolve to a declared aggregate")-      | sagaAgg (procSaga p) `notElem` aggNames-      ]-        ++ [ mkErr pl ProcessUnresolvedRef ("target '" <> procTarget p <> "' does not resolve to a declared aggregate")-           | procTarget p `notElem` aggNames-           ]-        ++ [ mkErr (locLine (tmLoc timer)) ProcessUnresolvedRef ("timer fire target '" <> fireTarget (tmFire timer) <> "' must be the saga or the target aggregate")-           | fireTarget (tmFire timer) `notElem` [sagaAgg (procSaga p), procTarget p]-           ]-        ++ resolveCommand pl "advance" (sagaAgg (procSaga p)) (advCommand advance) (advFields advance)-        ++ concatMap resolveDispatch (hDispatch (procHandle p))-        ++ resolveCommand (locLine (tmLoc timer)) "timer fire" (fireTarget fire) (fireCommand fire) (fireFields fire)-        ++ [ mkErr pl ProcessUnresolvedRef $-               "process '" <> procId p <> "' schedules undeclared timer '" <> hSchedule (procHandle p) <> "'; declared timer is '" <> tmName timer <> "'"-           | hSchedule (procHandle p) /= tmName timer-           ]-        ++ [ mkErr pl ProcessUnresolvedRef $-               "process '" <> procId p <> "' references undeclared projection table '" <> projection <> "'"-           | projection <- procProjections p,-             projection `notElem` projectionTables-           ]-      where-        advance = hAdvance (procHandle p)-        fire = tmFire timer-        resolveDispatch dispatch =-          resolveCommand-            (locLine (dispLoc dispatch))-            "dispatch"-            (dispTarget dispatch)-            (dispCommand dispatch)-            (dispFields dispatch)-        resolveCommand diagnosticLine context target command bindings = case lookupAggregate target of-          Nothing -> []-          Just aggregate -> case [decl | decl <- aggCommands aggregate, cmdName decl == command] of-            [] ->-              [ mkErr diagnosticLine ProcessUnresolvedRef $-                  context <> " command '" <> command <> "' is not declared by aggregate '" <> target <> "'"-              ]-            (declaration : _) ->-              [ mkErr diagnosticLine ProcessFieldBindingUnresolved $-                  context <> " command '" <> command <> "' binds undeclared target field '" <> fbName binding <> "'"-              | binding <- bindings,-                fbName binding `notElem` map aggregateFieldName (cmdFields declaration)-              ]-        lookupAggregate name = case [aggregate | aggregate <- aggregates, aggName aggregate == name] of-          (aggregate : _) -> Just aggregate-          [] -> Nothing--    strictSurfaceResolution-      | not (enforcesSpecSurfaceClosures languageContract) = []-      | otherwise = correlateFieldRule ++ dispatchKeyRules ++ bindingScopeRules ++ idFieldRules ++ fireWindowRule--    correlateFieldRule =-      [ mkErr pl ProcessKeyFieldUnknown $-          "correlate references 'input." <> corrField (procCorrelate p) <> "' but input '" <> inName (procInput p) <> "' does not declare that field"-      | corrField (procCorrelate p) `notElem` inputFields-      ]--    dispatchKeyRules =-      [ mkErr (locLine (dispLoc dispatch)) ProcessDispatchKeyUnresolved $-          "dispatch to '" <> dispTarget dispatch <> "' uses unresolved key '" <> dispKey dispatch <> "'; expected correlationId or input.<declared-field>"-      | dispatch <- hDispatch (procHandle p),-        not (processKeyInScope (dispKey dispatch))-      ]-        ++ [ mkErr (locLine (tmLoc timer)) ProcessDispatchKeyUnresolved $-               "timer fire to '" <> fireTarget (tmFire timer) <> "' uses unresolved key '" <> fireKey (tmFire timer) <> "'; expected correlationId or input.<declared-field>"-           | not (processKeyInScope (fireKey (tmFire timer)))-           ]--    processKeyInScope value =-      value == "correlationId"-        || case T.stripPrefix "input." value of-          Just field -> field `elem` inputFields-          Nothing -> False--    bindingScopeRules =-      bindingRules pl "advance" inputFields (advFields (hAdvance (procHandle p)))-        ++ concatMap-          (\dispatch -> bindingRules (locLine (dispLoc dispatch)) "dispatch" inputFields (dispFields dispatch))-          (hDispatch (procHandle p))-        ++ bindingRules-          (locLine (tmLoc timer))-          "timer fire"-          (inputFields <> map fbName (tmPayload timer) <> ["timerId"])-          (fireFields (tmFire timer))--    bindingRules diagnosticLine context bareScope bindings =-      [ mkErr diagnosticLine ProcessBindingUnscoped $-          context <> " binding '" <> fbName binding <> maybe "" ("=" <>) (fbValue binding) <> "' is outside the process input and timer scopes"-      | binding <- bindings,-        not (bindingInScope bareScope binding)-      ]--    bindingInScope bareScope binding = case fbValue binding of-      Nothing -> fbName binding `elem` bareScope-      Just value-        | isQuoted value -> True-        | value == "timer.id" -> True-        | Just field <- T.stripPrefix "input." value -> field `elem` inputFields-        | otherwise -> value `elem` bareScope--    isQuoted value = T.length value >= 2 && T.head value == '"' && T.last value == '"'--    idFieldRules =-      [ mkErr (locLine (tmLoc timer)) TimerIdFieldNotCorrelation $-          "timer '" <> tmName timer <> "' " <> context <> " derives from '" <> ideField expression <> "'; only correlationId is implemented by generated runtime code"-      | (context, expression) <- [("id", tmId timer), ("fired-event-id", fireFiredEventId (tmFire timer))],-        ideField expression /= "correlationId"-      ]--    fireWindowRule =-      windowRangeRule languageContract (locLine (tmLoc timer)) ("timer '" <> tmName timer <> "' fireAt") (faWindow (tmFireAt timer))--    timerCeiling =-      [ mkErr (locLine (tmLoc timer)) ProcessTimerCeilingInvalid $-          "timer '" <> tmName timer <> "' max-attempts must be at least 1"-      | tmMaxAttempts timer < 1-      ]--    policyRules =-      policyConsistency-        (procId p)-        (procLoc p)-        (procRejected p)-        [ (dispCommand dispatch, dispLoc dispatch, dispDisposition dispatch)-        | dispatch <- hDispatch (procHandle p)-        ]--    ambiguityRule =-      [ mkErr (locLine (tmLoc timer)) AmbiguousMarkedBenign $-          "timer '" <> tmName timer <> "' maps on-ambiguous => Fired; CommandAmbiguous means multiple aggregate edges matched and is never a benign success. Use on-ambiguous Retry so the attempts ceiling dead-letters the definition bug"-      | onAmbiguous (fireDisposition (tmFire timer)) == OFired-      ]--    -- Surface the dangerous benign inversions the author confirmed (warnings).-    benignInversions =-      [ Diagnostic (locLine (tmLoc timer)) Warning ProcessBenignInversion [] $-          "timer '" <> tmName timer <> "' maps on-reject => Fired (a CommandRejected is treated as benign success)"-      | onReject (fireDisposition (tmFire timer)) == OFired-      ]-        ++ [ Diagnostic (locLine (dispLoc d)) Warning ProcessBenignInversion [] $-               "dispatch to '" <> dispTarget d <> "' maps on-duplicate => AckOk (a duplicate is treated as benign success)"-           | d <- hDispatch (procHandle p),-             onDuplicate (dispDisposition d) == DAckOk-           ]---- | Explain why a process saga category is illegal.  The first four cases--- mirror 'Keiro.Stream.category' without introducing a runtime dependency into--- the toolchain library.  The final @:@ case is deliberately stricter because--- that prefix is reserved for the @wf:<name>@ workflow stream family.-sagaCategoryError :: Text -> Maybe Text-sagaCategoryError = runtimeIdentityError False--stableIdentityError :: Text -> Maybe Text-stableIdentityError = runtimeIdentityError True--runtimeIdentityError :: Bool -> Text -> Maybe Text-runtimeIdentityError allowsHyphen identity-  | T.null identity = Just "is empty; use a non-empty stable name"-  | identity == "$all" = Just "is reserved by the event store; choose a service-owned stable name"-  | not allowsHyphen && T.isInfixOf "-" identity = Just "contains '-' (kiroku's category/id boundary); write compound categories in camelCase, for example \"hospitalSurge\""-  | Just illegal <- T.find (\character -> isSpace character || isControl character) identity =-      Just ("contains whitespace or control character " <> T.pack (show illegal) <> "; remove it and use camelCase")-  | T.isInfixOf ":" identity = Just "contains ':' which is reserved for runtime stream-family prefixes; choose a stable name without ':'"-  | otherwise = Nothing---- | The generated lower-camel selector for a logical field or SQL column.--- Read-model notation stores SQL names such as @responder_id@ while router--- resolve rows and dispatch keys use the generated selector @responderId@.-logicalFieldSelector :: Text -> Text-logicalFieldSelector raw =-  case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of-    Right derived -> HaskellName.renderLowerCamelName (HaskellName.lowerCamel derived)-    Left _ -> raw-  where-    site =-      HaskellName.NameSite-        { HaskellName.siteKind = HaskellName.GeneratedFieldSite,-          HaskellName.siteLogicalName = raw,-          HaskellName.siteOwner = "validation field resolution",-          HaskellName.siteLine = 0-        }---- | EP-108 rules for a stateless content-based router.-validateRouter :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> RouterNode -> [Diagnostic]-validateRouter languageContract typeGraphResult spec router =-  concat-    [ references,-      keyField,-      bindingScope,-      commandReference,-      readModelReference,-      selectionChecks,-      policyRules,-      duplicateNotice,-      onAppendedArm-    ]-  where-    -- The process twin of this rule is in 'validateProcess'; both say the same-    -- thing because both runtimes do: a successful append is always acked.-    onAppendedArm =-      [ mkSurfaceRefusal languageContract dispatchLine DispatchOnAppendedUnsupported $-          "router dispatch '"-            <> rdCommand dispatch-            <> "' maps on-appended => "-            <> dispText (onAppended (rdDisposition dispatch))-            <> ", but a successful append is always acked: no runtime path retries or dead-letters an event it just appended. Write 'on-appended AckOk'"-      | onAppended (rdDisposition dispatch) /= DAckOk-      ]-    aggregates = [aggregate | NAggregate aggregate <- specNodes spec]-    readModels = [readModel | NReadModel readModel <- specNodes spec]-    inputFields = map fieldName (inFields (rtInput router))-    resolvedFields = rvRow (rtResolve router)-    dispatch = rtDispatch router-    routerLine = locLine (rtLoc router)-    dispatchLine = locLine (rdLoc dispatch)--    targetAggregate = case [aggregate | aggregate <- aggregates, aggName aggregate == rtTarget router] of-      aggregate : _ -> Just aggregate-      [] -> Nothing--    projectionTables = [projTable projection | aggregate <- aggregates, Just projection <- [aggProjection aggregate]]--    references =-      [ mkErr routerLine RouterUnresolvedRef $-          "router '" <> rtId router <> "' targets aggregate '" <> rtTarget router <> "' but no such aggregate is declared"-      | targetAggregate == Nothing-      ]-        ++ [ mkErr routerLine RouterUnresolvedRef $-               "router '" <> rtId router <> "' references undeclared projection table '" <> projection <> "'"-           | projection <- rtProjections router,-             projection `notElem` projectionTables-           ]--    keyField = case rvSource (rtResolve router) of-      ResolveDeclarative {} -> []-      _ ->-        [ mkErr routerLine RouterKeyFieldUnknown $-            "key references 'input." <> corrField (rtKey router) <> "' but input '" <> inName (rtInput router) <> "' does not declare that field"-        | corrField (rtKey router) `notElem` inputFields-        ]--    bindingScope = case rvSource (rtResolve router) of-      ResolveDeclarative {} -> []-      _ ->-        [ mkErr dispatchLine RouterBindingUnscoped $-            "dispatch binding '" <> fbName binding <> maybe "" ("=" <>) (fbValue binding) <> "' is outside the router input and resolve-row scopes"-        | binding <- rdFields dispatch,-          not (bindingInScope binding)-        ]-      where-        bindingInScope binding = case fbValue binding of-          Nothing -> fbName binding `elem` inputFields-          Just value-            | isQuoted value -> True-            | Just field <- T.stripPrefix "input." value -> field `elem` inputFields-            | Just field <- T.stripPrefix "resolved." value -> field `elem` resolvedFields-            | otherwise -> False-        isQuoted value = T.length value >= 2 && T.head value == '"' && T.last value == '"'--    commandReference = case targetAggregate of-      Nothing -> []-      Just aggregate -> case [command | command <- aggCommands aggregate, cmdName command == rdCommand dispatch] of-        [] ->-          [ mkErr dispatchLine RouterCommandUnknown $-              "dispatch command '" <> rdCommand dispatch <> "' is not declared by aggregate '" <> aggName aggregate <> "'"-          ]-        command : _ ->-          [ mkErr dispatchLine RouterCommandUnknown $-              "dispatch command '" <> rdCommand dispatch <> "' binds undeclared target field '" <> fbName binding <> "'"-          | binding <- rdFields dispatch,-            fbName binding `notElem` map aggregateFieldName (cmdFields command)-          ]--    readModelReference = case rvSource (rtResolve router) of-      ResolveHole -> []-      ResolveDeclarative {} -> []-      ResolveReadModel name ->-        case [readModel | readModel <- readModels, rmName readModel == name] of-          [] ->-            [ mkErr (locLine (rvLoc (rtResolve router))) RouterUnresolvedRef $-                "router '" <> rtId router <> "' resolve names readmodel '" <> name <> "' but no such readmodel node is declared"-            ]-          readModel : _ ->-            [ mkErr (locLine (rvLoc (rtResolve router))) RouterReadModelUnverified $-                "router '" <> rtId router <> "' resolve row field '" <> column <> "' is not a declared column of readmodel '" <> name <> "'"-            | enforcesSpecSurfaceClosures languageContract,-              column <- rvRow (rtResolve router),-              column `notElem` map (logicalFieldSelector . rmcName) (rmColumns readModel)-            ]--    selectionChecks = case rvSource (rtResolve router) of-      ResolveDeclarative {} -> case typeGraphResult of-        Left _ -> []-        Right graph -> case RouterSelection.checkRouterSelection languageContract graph spec router of-          Right _ -> []-          Left diagnostics -> map routerSelectionDiagnostic (NE.toList diagnostics)-      _ -> []--    policyRules =-      policyConsistency-        (rtId router)-        (rtLoc router)-        (rtRejected router)-        [(rdCommand dispatch, rdLoc dispatch, rdDisposition dispatch)]--    duplicateNotice =-      [ Diagnostic dispatchLine Warning RouterBenignInversion [] $-          "router dispatch '" <> rdCommand dispatch <> "' maps on-duplicate => AckOk; Keiro.Router confirms the event id against the target stream before treating the duplicate as benign"-      | onDuplicate (rdDisposition dispatch) == DAckOk-      ]--routerSelectionDiagnostic :: RouterSelection.RouterSelectionDiagnostic -> Diagnostic-routerSelectionDiagnostic diagnostic =-  mkErr-    (locLine (RouterSelection.selectionDiagnosticLoc diagnostic))-    (routerSelectionDiagnosticCode (RouterSelection.selectionDiagnosticCode diagnostic))-    (RouterSelection.selectionDiagnosticMessage diagnostic)--routerSelectionDiagnosticCode :: RouterSelection.RouterSelectionDiagnosticCode -> DiagnosticCode-routerSelectionDiagnosticCode = \case-  RouterSelection.SelectionNotDeclarative -> RouterSelectionNotDeclarative-  RouterSelection.SelectionCapabilityUnavailable -> RouterSelectionCapabilityUnavailable-  RouterSelection.SelectionIdentityEmpty -> RouterSelectionIdentityEmpty-  RouterSelection.SelectionVersionInvalid -> RouterSelectionVersionInvalid-  RouterSelection.SelectionQueryUnknown -> RouterSelectionQueryUnknown-  RouterSelection.SelectionQueryContractMissing -> RouterSelectionQueryContractMissing-  RouterSelection.SelectionQueryInputBindingInvalid -> RouterSelectionQueryInputBindingInvalid-  RouterSelection.SelectionQueryInputTypeMismatch -> RouterSelectionQueryInputTypeMismatch-  RouterSelection.SelectionQueryResultNotList -> RouterSelectionQueryResultNotList-  RouterSelection.SelectionQueryRowNotStructural -> RouterSelectionQueryRowNotStructural-  RouterSelection.SelectionExpressionRootUnknown -> RouterSelectionExpressionRootUnknown-  RouterSelection.SelectionExpressionFieldUnknown -> RouterSelectionExpressionFieldUnknown-  RouterSelection.SelectionExpressionFieldOptional -> RouterSelectionExpressionFieldOptional-  RouterSelection.SelectionExpressionTypeMismatch -> RouterSelectionExpressionTypeMismatch-  RouterSelection.SelectionPredicateNotBool -> RouterSelectionPredicateNotBool-  RouterSelection.SelectionRecipientNotText -> RouterSelectionRecipientNotText-  RouterSelection.SelectionOperatorUnsupported -> RouterSelectionOperatorUnsupported-  RouterSelection.SelectionRecipientLimitMissing -> RouterSelectionRecipientLimitMissing-  RouterSelection.SelectionRecipientLimitInvalid -> RouterSelectionRecipientLimitInvalid-  RouterSelection.SelectionOrderUnsupported -> RouterSelectionOrderUnsupported-  RouterSelection.SelectionDedupeUnsupported -> RouterSelectionDedupeUnsupported-  RouterSelection.SelectionFailureAckForbidden -> RouterSelectionFailureAckForbidden-  RouterSelection.SelectionRedeliveryUnsupported -> RouterSelectionRedeliveryUnsupported-  RouterSelection.SelectionPartialDispatchUnsupported -> RouterSelectionPartialDispatchUnsupported-  RouterSelection.SelectionTargetAmbiguous -> RouterSelectionTargetAmbiguous-  RouterSelection.SelectionCommandUnknown -> RouterSelectionCommandUnknown-  RouterSelection.SelectionCommandMappingDuplicate -> RouterSelectionCommandMappingDuplicate-  RouterSelection.SelectionCommandMappingIncomplete -> RouterSelectionCommandMappingIncomplete-  RouterSelection.SelectionCommandMappingTypeMismatch -> RouterSelectionCommandMappingTypeMismatch---- | Reconcile per-dispatch prose with the one node-level policy the runtime--- actually applies to a rejection-class failure group.-policyConsistency :: Name -> Loc -> PolicyChoice -> [(Name, Loc, DispatchDisposition)] -> [Diagnostic]-policyConsistency nodeName nodeLoc rejectedPolicy dispatches = contradictions ++ divergent ++ unused ++ ambiguityWarning-  where-    contradictions =-      [ mkErr (locLine dispatchLoc) PolicyContradiction $-          "dispatch '" <> command <> "' declares on-failed DeadLetter, but node '" <> nodeName <> "' does not declare rejected => deadLetter; align the dispatch story with the node-level RejectedCommandPolicy"-      | (command, dispatchLoc, disposition) <- dispatches,-        DDeadLetter _ <- [onFailed disposition],-        rejectedPolicy /= PolDeadLetter-      ]--    divergent = case dispatches of-      [] -> []-      (_, _, firstDisposition) : rest ->-        [ mkErr (locLine dispatchLoc) PolicyContradiction $-            "dispatch '" <> command <> "' has a different on-failed action from another dispatch in node '" <> nodeName <> "'; the runtime applies one RejectedCommandPolicy to the whole failure group"-        | (command, dispatchLoc, disposition) <- rest,-          not (sameFailureAction (onFailed disposition) (onFailed firstDisposition))-        ]--    unused =-      [ Diagnostic (locLine nodeLoc) Warning PolicyDeadLetterUnused [] $-          "node '" <> nodeName <> "' declares rejected => deadLetter but no dispatch on-failed arm says DeadLetter; the runtime policy is live, but the per-dispatch notation does not acknowledge it"-      | rejectedPolicy == PolDeadLetter,-        all (not . isDeadLetter . onFailed . third) dispatches-      ]--    ambiguityWarning =-      [ Diagnostic (locLine nodeLoc) Warning AmbiguousFollowsRejectedPolicy [] $-          "node '" <> nodeName <> "' acknowledges rejection-class failures; CommandAmbiguous follows the same rejected policy, and a dead-letter errorClass is the durable witness of that definition bug"-      | rejectedPolicy `elem` [PolDeadLetter, PolSkip]-      ]--    third (_, _, value) = value-    sameFailureAction DDeadLetter {} DDeadLetter {} = True-    sameFailureAction left right = left == right-    isDeadLetter DDeadLetter {} = True-    isDeadLetter _ = False--validateAggregate :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> Aggregate -> [Diagnostic]-validateAggregate languageContract typeGraphResult spec agg =-  concat-    [ emptyAggregate,-      duplicateMembers,-      declaredRefs,-      eventBodyRefs,-      outputMappingRules,-      registerInitialScope,-      reachability,-      terminalNoOutgoing,-      guardScope,-      clockFree,-      projectionKeyResolution,-      projectionSafety,-      statusMapTotality,-      evolutionRules,-      snapshotRules,-      replayOnlyRules,-      eventlessStateChangeRules,-      domainOutcomeRules,-      wirePolicyRules,-      fieldWireKeyRules-    ]-  where-    emptyAggregate =-      [ mkErr (locLine (aggLoc agg)) AggregateEmpty $-          "aggregate '"-            <> aggName agg-            <> "' declares "-            <> renderMissing missingAggregateParts-            <> "; scaffold cannot lower an empty aggregate -- declare at least one command, one event, and one transition"-      | not (null missingAggregateParts)-      ]-    missingAggregateParts =-      [ label-      | (isMissing, label) <--          [ (null (aggCommands agg), "no commands"),-            (null (aggEvents agg), "no events"),-            (null (aggTransitions agg), "no transitions")-          ],-        isMissing-      ]-    renderMissing [] = ""-    renderMissing [onlyPart] = onlyPart-    renderMissing [firstPart, secondPart] = firstPart <> " and " <> secondPart-    renderMissing parts = T.intercalate ", " (init parts) <> ", and " <> last parts--    states = Set.fromList (map stName (aggStates agg))-    terminals = Set.fromList [stName s | s <- aggStates agg, stTerminal s]-    commandFields :: Map Name [Name]-    commandFields = Map.fromList [(cmdName c, map aggregateFieldName (cmdFields c)) | c <- aggCommands agg]-    commandNames = Map.keysSet commandFields-    eventNames = Set.fromList (map evName (aggEvents agg))-    enumCtorNames = Set.fromList [c | e <- specEnums spec, (c, _) <- enumCtors e]-    ruleNames = Set.fromList (map ruleName (specRules spec))-    registerNames = Set.fromList (map regName (aggRegs agg))--    eventFieldsFor event =-      case evBody event of-        EventFields fields -> fields-        EventFromCommand commandName ->-          [ field-          | command <- aggCommands agg,-            cmdName command == commandName,-            field <- cmdFields command-          ]--    fieldWireKeyRules =-      concat-        [ wireKeyRulesForRecord-            ("aggregate '" <> aggName agg <> "' command '" <> cmdName command <> "'")-            Nothing-            (map resolveAggregateFieldIdentity (cmdFields command))-        | command <- aggCommands agg-        ]-        <> concat-          [ wireKeyRulesForRecord-              ("aggregate '" <> aggName agg <> "' event '" <> evName event <> "'")-              (Just ("kind", "event envelope key"))-              (map resolveAggregateFieldIdentity (eventFieldsFor event))-          | event <- aggEvents agg-          ]--    snapshotRules = case aggSnapshot agg of-      Nothing -> []-      Just snapshot ->-        [ mkErr (locLine (snapLoc snapshot)) SnapshotIntervalInvalid $-            "aggregate '" <> aggName agg <> "': snapshot every requires an interval of at least 1; non-positive runtime intervals silently disable snapshots"-        | SnapEvery interval <- [snapPolicy snapshot],-          interval < 1-        ]-          ++ [ mkErr (locLine (snapLoc snapshot)) SnapshotCodecFixtureInvalid $-                 "aggregate '" <> aggName agg <> "': snapshot state-codec version must be at least 1 and shape-hash must be non-empty"-             | snapCodecVersion snapshot < 1 || T.null (snapShapeHash snapshot)-             ]--    wirePolicyRules = case aggWire agg of-      Just wire-        | enforcesSpecSurfaceClosures languageContract,-          wireKind wire /= "ctorName" || wireFields wire /= "camelCase" ->-            [ mkErr (locLine (aggLoc agg)) WireClauseUnsupported $-                "aggregate '"-                  <> aggName agg-                  <> "' wire clause describes kind="-                  <> wireKind wire-                  <> " fields="-                  <> wireFields wire-                  <> "; generated bytes currently support only kind=ctorName fields=camelCase"-            ]-      _ -> []--    duplicateMembers =-      [ mkErr (locLine (cmdLoc c)) DuplicateCommandName $-          "aggregate '" <> aggName agg <> "' declares command '" <> cmdName c <> "' more than once"-      | c <- duplicatesBy cmdName (aggCommands agg)-      ]-        ++ [ mkErr (locLine (evLoc e)) DuplicateEventName $-               "aggregate '" <> aggName agg <> "' declares event '" <> evName e <> "' more than once"-           | e <- duplicatesBy evName (aggEvents agg)-           ]-        ++ [ mkErr (locLine (aggregateFieldLoc field)) AggregateDuplicateFieldName $-               "aggregate '" <> aggName agg <> "' command '" <> cmdName command <> "' declares field '" <> aggregateFieldName field <> "' more than once"-           | command <- aggCommands agg,-             field <- duplicatesBy aggregateFieldName (cmdFields command)-           ]-        ++ [ mkErr (locLine (aggregateFieldLoc field)) AggregateDuplicateFieldName $-               "aggregate '" <> aggName agg <> "' event '" <> evName event <> "' declares field '" <> aggregateFieldName field <> "' more than once"-           | event <- aggEvents agg,-             EventFields fields <- [evBody event],-             field <- duplicatesBy aggregateFieldName fields-           ]-        ++ [ mkErr (locLine (stLoc state)) AggregateDuplicateState $-               "aggregate '" <> aggName agg <> "' declares state '" <> stName state <> "' more than once"-           | state <- duplicatesBy stName (aggStates agg)-           ]-        ++ [ mkErr (locLine (regLoc register)) AggregateDuplicateRegister $-               "aggregate '" <> aggName agg <> "' declares register '" <> regName register <> "' more than once"-           | enforcesSpecSurfaceClosures languageContract,-             register <- duplicatesBy regName (aggRegs agg)-           ]-        ++ [ mkErr (locLine (tLoc transition)) TransitionDuplicateUnguarded $-               "aggregate '"-                 <> aggName agg-                 <> "' has more than one live unguarded transition for '"-                 <> tSource transition-                 <> " -- "-                 <> tCommand transition-                 <> "'; every matching command would be ambiguous"-           | group <- duplicateGroupsBy transitionKey unguardedTransitions,-             transition <- group-           ]-        ++ [ mkErr (locLine (tLoc guarded)) TransitionUnguardedSibling $-               "aggregate '"-                 <> aggName agg-                 <> "' guarded transition '"-                 <> tSource guarded-                 <> " -- "-                 <> tCommand guarded-                 <> "' overlaps an unguarded sibling at line "-                 <> tInt (locLine (tLoc unguarded))-           | enforcesSpecSurfaceClosures languageContract,-             guarded <- liveTransitions,-             tGuard guarded /= Nothing,-             unguarded : _ <- [[candidate | candidate <- unguardedTransitions, transitionKey candidate == transitionKey guarded]]-           ]-    liveTransitions = [transition | transition <- aggTransitions agg, tMode transition == TmLive]-    unguardedTransitions = [transition | transition <- liveTransitions, tGuard transition == Nothing]-    transitionKey transition = (tSource transition, tCommand transition)--    eventBodyRefs =-      [ mkErr (locLine (evLoc e)) UndeclaredCommand $-          "event '" <> evName e <> "' copies fields from undeclared command '" <> command <> "'"-      | e <- aggEvents agg,-        EventFromCommand command <- [evBody e],-        command `Set.notMember` commandNames-      ]--    outputMappingRules =-      [ mkErr (locLine (tLoc transition)) EventOutputCommandMismatch $-          "transition '"-            <> tSource transition-            <> " -- "-            <> consuming-            <> "' emits event '"-            <> eventName-            <> "' declared as fields("-            <> declared-            <> "); generated identity output is legal only when the transition consumes that same command"-      | transition <- aggTransitions agg,-        (emitIndex, eventName) <- zip [1 ..] (tEmits transition),-        Left OutputCommandMismatch {declaredSourceCommand = declared, consumingTransitionCommand = consuming} <- [eventOutputMappingFromGraphResult typeGraphResult spec agg transition emitIndex eventName]-      ]--    registerInitialScope = concatMap checkRegisterInitial (aggRegs agg)-    checkRegisterInitial r = case [e | e <- specEnums spec, TRef (enumName e) == regType r] of-      (e : _) -> case enumBinding e of-        Just _ ->-          [ outOfScope r "declaration-owned symbol selected by" "initial"-          | regInitialBare r /= Just "initial"-          ]-        Nothing ->-          [ outOfScope r "constructor of enum" (enumName e)-          | regInitialBare r `notElem` map (Just . fst) (enumCtors e)-          ]-      []-        | regType r == TRef (aggName agg <> "Vertex") ->-            [ outOfScope r "state of aggregate" (aggName agg)-            | maybe True (`Set.notMember` states) (regInitialBare r)-            ]-        | Just identifier <- firstMatching (\declaration -> regType r == TRef (idName declaration)) (specIds spec) -> case idBinding identifier of-            Just _ ->-              [ outOfScope r "declaration-owned symbol selected by" "initial"-              | regInitialBare r /= Just "initial"-              ]-            Nothing ->-              [ outOfScope r "literal" "placeholder"-              | regInitialBare r /= Just "placeholder"-              ]-        | otherwise -> []-    outOfScope r expected domain =-      mkErr (locLine (regLoc r)) RegisterInitialOutOfScope $-        "register '" <> regName r <> "' initial '" <> renderRegInitial (regInitial r) <> "' is not a " <> expected <> " '" <> domain <> "'"-    regInitialBare r = case regInitial r of-      RegInitBare value -> Just value-      RegInitText _ -> Nothing-    renderRegInitial = \case-      RegInitBare value -> value-      RegInitText value -> value--    -- Rule 1: declared-reference for command / emit / goto / source.-    declaredRefs =-      concatMap transitionRefs (aggTransitions agg)-    transitionRefs t =-      [ mkErr (locLine (tLoc t)) UndeclaredCommand $-          "transition references undeclared command '" <> tCommand t <> "'"-      | not (tCommand t `Set.member` commandNames)-      ]-        ++ [ mkErr (locLine (tLoc t)) UndeclaredState $-               "transition source '" <> tSource t <> "' is not a declared state"-           | not (tSource t `Set.member` states)-           ]-        ++ [ mkErr (locLine (tLoc t)) UndeclaredState $-               "transition goto '" <> tGoto t <> "' is not a declared state"-           | not (tGoto t `Set.member` states)-           ]-        ++ [ mkErr (locLine (tLoc t)) UndeclaredEvent $-               "emit references undeclared event '" <> ev <> "'"-           | ev <- tEmits t,-             not (ev `Set.member` eventNames)-           ]--    -- Rule 2: reachability of every non-terminal state from the initial state-    -- (the first state in the list).-    reachability = case map stName (aggStates agg) of-      [] -> []-      (initial : _) ->-        let reached = bfs (Set.singleton initial) [initial]-         in [ mkErr (locLine (stLoc s)) UnreachableState $-                "state '" <> stName s <> "' is not reachable from the initial state '" <> initial <> "'"-            | s <- aggStates agg,-              not (stTerminal s),-              not (stName s `Set.member` reached)-            ]-    edgesFrom src = [tGoto t | t <- aggTransitions agg, tSource t == src]-    bfs seen [] = seen-    bfs seen (x : xs) =-      let nexts = [n | n <- edgesFrom x, not (n `Set.member` seen)]-       in bfs (foldr Set.insert seen nexts) (xs ++ nexts)--    -- Rule 3: a terminal state has no outgoing transition.-    terminalNoOutgoing =-      [ mkErr (locLine (tLoc t)) TerminalHasOutgoing $-          "terminal state '" <> tSource t <> "' has an outgoing transition"-      | t <- aggTransitions agg,-        tSource t `Set.member` terminals-      ]--    -- Rule 4: every atom in a guard or write Expr resolves to a register, a-    -- field of the transition's command, an enum constructor, a rule, or a bool.-    guardScope = concatMap transitionScope (aggTransitions agg)-    transitionScope t =-      let inScope =-            registerNames-              `Set.union` Set.fromList (Map.findWithDefault [] (tCommand t) commandFields)-              `Set.union` enumCtorNames-              `Set.union` ruleNames-              -- State names are constructors of the implicit vertex enum, so a-              -- @write reservationState := Held@ references a state legitimately.-              `Set.union` states-          exprs = maybe [] pure (tGuard t) ++ map snd (tWrites t)-          badAtoms =-            [ n-            | e <- exprs,-              n <- exprNames e,-              not (n `Set.member` clockAtoms), -- clock atoms reported separately-              not (n `Set.member` inScope)-            ]-          badTargets = [target | (target, _) <- tWrites t, target `Set.notMember` registerNames]-       in [ mkErr (locLine (tLoc t)) WriteTargetNotRegister $-              "write target '" <> target <> "' is not a register of aggregate '" <> aggName agg <> "'"-          | target <- dedup badTargets-          ]-            ++ [ mkErr (locLine (tLoc t)) GuardAtomOutOfScope $-                   "atom '" <> n <> "' in transition '" <> tSource t <> " -- " <> tCommand t <> "' resolves to no register, command field, enum constructor, or rule"-               | n <- dedup badAtoms-               ]--    -- Rule 5 (cross-cutting): no guard or write Expr samples a wall clock.-    clockFree = concatMap transitionClock (aggTransitions agg)-    transitionClock t =-      let exprs = maybe [] pure (tGuard t) ++ map snd (tWrites t)-          sampled = [n | e <- exprs, n <- exprNames e, n `Set.member` clockAtoms]-       in [ mkErr (locLine (tLoc t)) ClockSampled $-              "transition '" <> tSource t <> " -- " <> tCommand t <> "' samples the wall clock via '" <> n <> "'; time must be an injected input field, not sampled"-          | n <- dedup sampled-          ]--    -- EP-107: a projection references a first-class read model when one exists.-    -- Legacy standalone projections remain legal, but are surfaced as warnings.-    projectionKeyResolution =-      [ mkErr (locLine (projLoc projection)) AggProjectionKeyUnresolved $-          "projection '" <> projTable projection <> "' key '" <> projKey projection <> "' is not a register, command field, or event field of aggregate '" <> aggName agg <> "'"-      | enforcesSpecSurfaceClosures languageContract,-        Just projection <- [aggProjection agg],-        projKey projection `Set.notMember` projectionFields-      ]-    projectionFields =-      registerNames-        `Set.union` Set.fromList [fieldDslName (resolveAggregateFieldIdentity field) | command <- aggCommands agg, field <- cmdFields command]-        `Set.union` Set.fromList [fieldDslName (resolveAggregateFieldIdentity field) | event <- aggEvents agg, field <- eventFieldsFor event]--    projectionSafety = case aggProjection agg of-      Nothing -> []-      Just projection -> case [readModel | NReadModel readModel <- specNodes spec, rmName readModel == projTable projection] of-        [] ->-          [ mkErr (locLine (projLoc projection)) RmStrongInlineOnly $-              "projection '" <> projTable projection <> "' declares consistency = Strong but has no readmodel node; a standalone projection is inline-only and has no subscription cursor"-          | projConsistency projection == Just Strong-          ]-            ++ [ Diagnostic-                   { line = locLine (projLoc projection),-                     severity = Warning,-                     code = RmProjectionWithoutNode,-                     relatedLocations = [],-                     message = "projection '" <> projTable projection <> "' has no readmodel node; registration, schema identity, consistency, and rebuild helpers are unavailable"-                   }-               ]-        (readModel : _) ->-          [ mkErr (locLine (projLoc projection)) RmConsistencyConflict $-              "projection '" <> projTable projection <> "' declares consistency " <> T.pack (show projectionConsistency) <> " but its readmodel node declares " <> T.pack (show readModelConsistency)-          | Just projectionConsistency <- [projConsistency projection],-            Just readModelConsistency <- [legacyReadModelConsistency readModel],-            projectionConsistency /= readModelConsistency-          ]--    -- Rule 6 (hole-kind 3, mapping): keys are exact event names, never suffixes;-    -- duplicates and dangling keys are errors, and non-partial maps are total.-    statusMapTotality = case aggProjection agg of-      Nothing -> []-      Just p ->-        let evs = map evName (aggEvents agg)-            pairs = maybe [] mapPairs (projStatusMap p)-            keys = map fst pairs-            partial = maybe False mapPartial (projStatusMap p)-            uncovered = [event | event <- evs, event `notElem` keys]-            dangling = [key | key <- keys, key `notElem` evs]-            duplicateKeys = map fst (duplicatesBy fst pairs)-         in [ mkErr (locLine (projLoc p)) StatusMapDanglingKey $-                "projection '" <> projTable p <> "' status-map key '" <> key <> "' is not an event name of aggregate '" <> aggName agg <> "'"-            | key <- dangling-            ]-              ++ [ mkErr (locLine (projLoc p)) StatusMapDuplicateKey $-                     "projection '" <> projTable p <> "' repeats status-map key '" <> key <> "'"-                 | key <- duplicateKeys-                 ]-              ++ [ mkErr (locLine (projLoc p)) StatusMapNotTotal $-                     "projection '" <> projTable p <> "' status-map is not total over events {" <> T.intercalate ", " uncovered <> "}"-                 | not partial,-                   not (null evs),-                   not (null uncovered)-                 ]--    -- EP-2 evolution rules (single-spec; the diff path adds the cross-spec ones).-    evolutionRules =-      versionUpcasterRule-        ++ upcasterChainGapRule-        ++ deprecatedEmitRule-        ++ eventRetirementRules-        ++ wireVersionRule-    -- Only live transitions are the write path: a replay-only transition can-    -- never fire forward, so its emits exist purely to invert stored events —-    -- which is exactly where a deprecated event is allowed to remain-    -- (plan 143; supersedes the guarded-but-inert retained-edge pattern).-    liveEmittedNames = Set.fromList (concatMap tEmits [t | t <- aggTransitions agg, tMode t == TmLive])-    replayEmittedNames = Set.fromList (concatMap tEmits [t | t <- aggTransitions agg, tMode t == TmReplayOnly])-    maxEventVersion = maximum (1 : map evVersion (aggEvents agg))-    upcasterSources =-      Set.fromList-        [ source-        | event <- aggEvents agg,-          Just (source, _) <- [evUpcastFrom event]-        ]--    -- A non-initial event version must carry a contiguous upcaster (from v-1).-    versionUpcasterRule =-      [ mkErr (locLine (evLoc e)) EvtVersionMissingUpcaster $-          "event '" <> evName e <> "' version " <> tInt (evVersion e) <> " has no 'upcast from v" <> tInt (evVersion e - 1) <> "' clause"-      | e <- aggEvents agg,-        evVersion e > 1,-        maybe True ((/= evVersion e - 1) . fst) (evUpcastFrom e)-      ]--    -- Aggregate schema stamps are global, so every source version below the-    -- current maximum needs a permanent rung regardless of which event owns it.-    upcasterChainGapRule =-      [ mkErr (locLine (aggLoc agg)) UpcasterChainGap $-          "no event declares 'upcast from v"-            <> tInt missing-            <> "'; stored payloads stamped v"-            <> tInt missing-            <> " can never reach v"-            <> tInt maxEventVersion-            <> " (GapInUpcasterChain at hydration). A rung, once shipped, must exist forever — restore the upcaster for v"-            <> tInt missing-            <> " (re-declare it on the event whose shape changed at v"-            <> tInt (missing + 1)-            <> ")"-      | missing <- [1 .. maxEventVersion - 1],-        missing `Set.notMember` upcasterSources-      ]--    -- A deprecated event must have left the write path.-    deprecatedEmitRule =-      [ mkErr (locLine (evLoc e)) DeprecatedEventStillEmitted $-          "deprecated event '" <> evName e <> "' is still emitted by a transition"-      | e <- aggEvents agg,-        evDeprecated e,-        evName e `Set.member` liveEmittedNames-      ]--    -- Retirement is a two-stage protocol. The pre-cutover marker keeps a live-    -- emitter. The deprecated stage removes that live emitter but retains a-    -- replay-only emitter until old payloads no longer need hydration.-    eventRetirementRules = concatMap eventRetirementRule (aggEvents agg)-    eventRetirementRule event-      | evRetiring event =-          [ mkErr (locLine (evLoc event)) EventRetirementInProgress $-              "retiring event '" <> evName event <> "' has no live emitting transition; keep it emitting while streams are terminalized or truncated, or cut over to 'deprecated event' with a replay-only emitting transition"-          | evName event `Set.notMember` liveEmittedNames-          ]-            ++ [ Diagnostic-                   { line = locLine (evLoc event),-                     severity = Warning,-                     code = EventRetirementInProgress,-                     relatedLocations = [],-                     message =-                       "event '" <> evName event <> "' is retiring: it stays fully live and replayable. Keep its live emitting transition until every affected stream is terminal or truncated; then flip it to 'deprecated event' and retain an equivalent replay-only emitting transition for as long as old payloads may be hydrated"-                   }-               | evName event `Set.member` liveEmittedNames-               ]-      | evDeprecated event =-          [ Diagnostic-              { line = locLine (evLoc event),-                severity = Warning,-                code = DeprecatedEventReplayHazard,-                relatedLocations = [],-                message =-                  "deprecated event '" <> evName event <> "' stays decodable but is not replayable: no replay-only transition emits it, so hydration of a live stream containing it fails with HydrationNoInvertingEdge. Restore an equivalent replay-only emitting transition, or terminalize/truncate every affected stream before deployment"-              }-          | any (not . stTerminal) (aggStates agg),-            evName event `Set.notMember` replayEmittedNames-          ]-            ++ [ Diagnostic-                   { line = locLine (evLoc event),-                     severity = Warning,-                     code = EventRetirementInProgress,-                     relatedLocations = [],-                     message =-                       "deprecated event '" <> evName event <> "' is off the live write path and remains replayable through a replay-only transition; retain that transition until every stream containing the event is terminal, truncated, or passes the replay audit"-                   }-               | evName event `Set.member` replayEmittedNames-               ]-      | otherwise = []--    -- The explicit `wire schemaVersion=` (if any) must equal the max event version.-    wireVersionRule = case aggWire agg of-      Just w-        | wireSchemaVersion w /= maxEventVersion ->-            [ Diagnostic-                { line = locLine (aggLoc agg),-                  severity = Warning,-                  code = WireSchemaVersionMismatch,-                  relatedLocations = [],-                  message =-                    "wire schemaVersion=" <> tInt (wireSchemaVersion w) <> " does not match the maximum event version " <> tInt maxEventVersion-                }-            ]-      _ -> []--    -- Plan 143: replay-only transition discipline. A replay-only transition-    -- exists to invert stored events, so one that emits nothing is dead-    -- weight (error); one whose (source, command) pair has no live sibling-    -- means the command is fully retired at that state — legitimate, but the-    -- fuller procedure is event retirement (docs/plans/139), so warn.-    replayOnlyRules = concatMap replayOnlyRule (aggTransitions agg)-    replayOnlyRule t-      | tMode t /= TmReplayOnly = []-      | otherwise =-          [ mkErr (locLine (tLoc t)) ReplayOnlyEmitsNothing $-              "replay-only transition '" <> tSource t <> " -- " <> tCommand t <> "' emits no event; a replay-only transition exists to invert stored events and is dead weight without an emit"-          | null (tEmits t)-          ]-            ++ [ Diagnostic-                   { line = locLine (tLoc t),-                     severity = Warning,-                     code = ReplayOnlyCommandStillLive,-                     relatedLocations = [],-                     message =-                       "replay-only transition '" <> tSource t <> " -- " <> tCommand t <> "' has no live sibling; command '" <> tCommand t <> "' is fully retired at state '" <> tSource t <> "' — if the intent is to retire its events too, follow the event-retirement procedure (docs/plans/139)"-                   }-               | not (any (\sibling -> tMode sibling == TmLive && tSource sibling == tSource t && tCommand sibling == tCommand t) (aggTransitions agg))-               ]--    eventlessStateChangeRules =-      [ mkErr (locLine (tLoc transition)) AggregateEventlessStateChange $-          "transition '"-            <> tSource transition-            <> " -- "-            <> tCommand transition-            <> "' emits no event but changes "-            <> changeDescription transition-            <> "; event-sourced state changes require persisted evidence, while a no-op must keep both vertex and registers unchanged"-      | transition <- aggTransitions agg,-        null (tEmits transition),-        tSource transition /= tGoto transition || not (null (tWrites transition))-      ]-    changeDescription transition-      | tSource transition /= tGoto transition && not (null (tWrites transition)) = "the target vertex and registers"-      | tSource transition /= tGoto transition = "the target vertex"-      | otherwise = "registers"--    domainOutcomeRules =-      declarationRules-        ++ concatMap transitionOutcomeRules (aggTransitions agg)-      where-        declarationRules =-          [ mkErr (locLine loc) DomainOutcomeDeclarationDuplicate $-              "aggregate '" <> aggName agg <> "' declares domain-outcomes more than once"-          | loc <- aggDomainOutcomeDuplicateLocs agg-          ]-            ++ case aggDomainOutcomeTypes agg of-              Nothing ->-                [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeDeclarationMissing $-                    "transition '" <> tSource transition <> " -- " <> tCommand transition <> "' declares an outcome but aggregate '" <> aggName agg <> "' has no domain-outcomes declaration"-                | transition <- aggTransitions agg,-                  Just outcome <- [tOutcome transition]-                ]-              Just _ -> []--        transitionOutcomeRules transition =-          [ mkErr (locLine loc) DomainOutcomeClauseDuplicate $-              "transition '" <> tSource transition <> " -- " <> tCommand transition <> "' declares outcome more than once"-          | loc <- tOutcomeDuplicateLocs transition-          ]-            ++ case (aggDomainOutcomeTypes agg, tMode transition, tOutcome transition) of-              (Just _, TmLive, Nothing) ->-                [ mkErr (locLine (tLoc transition)) DomainOutcomeClauseMissing $-                    "live transition '" <> tSource transition <> " -- " <> tCommand transition <> "' is missing its required outcome clause"-                ]-              (Just _, TmReplayOnly, Just outcome) ->-                [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeReplayOnlyClause $-                    "replay-only transition '" <> tSource transition <> " -- " <> tCommand transition <> "' cannot declare a forward command outcome"-                ]-              (Just _, TmLive, Just (OutcomeAccepted loc)) ->-                [ mkErr (locLine loc) DomainOutcomeAcceptedWithoutEvents $-                    "accepted transition '" <> tSource transition <> " -- " <> tCommand transition <> "' must emit at least one event"-                | null (tEmits transition)-                ]-              (Just _, TmLive, Just outcome@OutcomeRejected {}) -> silentRules outcome-              (Just _, TmLive, Just outcome@OutcomeNoOp {}) -> silentRules outcome-              _ -> []-          where-            silentRules outcome =-              [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentEmits $-                  "silent transition '" <> tSource transition <> " -- " <> tCommand transition <> "' cannot emit events"-              | not (null (tEmits transition))-              ]-                ++ [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentWrites $-                       "silent transition '" <> tSource transition <> " -- " <> tCommand transition <> "' cannot write aggregate registers"-                   | not (null (tWrites transition))-                   ]-                ++ [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentStateChange $-                       "silent transition '" <> tSource transition <> " -- " <> tCommand transition <> "' must preserve its source state"-                   | tGoto transition /= tSource transition-                   ]---- | The validator's re-derivation of the live--- 'Keiro.PGMQ.Runtime.queueRef' trio: physical queue, dead-letter queue, and--- PGMQ backing table. Parity is pinned by the queue-runtime conformance suite.-derivedQueueTrio :: Text -> (Text, Text, Text)-derivedQueueTrio logical = (physical, physical <> "_dlq", "pgmq.q_" <> physical)-  where-    physical = physicalBase logical--physicalBase :: Text -> Text-physicalBase logical-  | T.length base <= 43 && not ("_dlq" `T.isSuffixOf` base) = base-  | otherwise = hashedBase logical base-  where-    base = sanitizeQueueName logical--sanitizeQueueName :: Text -> Text-sanitizeQueueName =-  ensureLeadingLetter-    . T.intercalate "_"-    . filter (not . T.null)-    . T.splitOn "_"-    . T.map toLegal-    . T.toLower-  where-    toLegal c-      | (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '_' = c-      | otherwise = '_'-    ensureLeadingLetter value = case T.uncons value of-      Nothing -> "q"-      Just (c, _)-        | c >= 'a' && c <= 'z' -> value-        | otherwise -> T.cons 'q' value--hashedBase :: Text -> Text -> Text-hashedBase logical base = prefix <> "_" <> fnv1a64Hex logical-  where-    trimmedPrefix = T.dropWhileEnd (== '_') (T.take 26 base)-    prefix-      | T.null trimmedPrefix = "q"-      | otherwise = trimmedPrefix--fnv1a64Hex :: Text -> Text-fnv1a64Hex logical = T.pack (replicate (16 - length rendered) '0' <> rendered)-  where-    rendered = showHex (T.foldl' step offset logical) ""-    offset :: Word64-    offset = 0xcbf29ce484222325-    prime :: Word64-    prime = 0x100000001b3-    step hash character = (hash `xor` fromIntegral (ord character)) * prime--tInt :: Int -> Text-tInt = T.pack . show--mkErr :: Int -> DiagnosticCode -> Text -> Diagnostic-mkErr l c m = Diagnostic {line = l, severity = Error, code = c, relatedLocations = [], message = m}---- | A dispatch disposition as the author spelled it.-dispText :: Disp -> Text-dispText DAckOk = "AckOk"-dispText DRetry = "Retry"-dispText (DDeadLetter reason) = "DeadLetter " <> T.pack (show reason)---- | A spec surface the grammar accepts but no runtime implements.------ Released languages below 4 keep their acceptance and only warn, so an--- existing source does not stop checking when it is pinned to an older--- language. From language 4 — which promised strict spec-surface validation —--- the same sentence is an error. The message never changes with the severity, so--- an author reads one explanation before and after the tightening.-mkSurfaceRefusal :: EffectiveLanguageContract -> Int -> DiagnosticCode -> Text -> Diagnostic-mkSurfaceRefusal languageContract l c m =-  Diagnostic-    { line = l,-      severity = if enforcesSpecSurfaceClosures languageContract then Error else Warning,-      code = c,-      relatedLocations = [],-      message = m-    }--wireKeyRulesForRecord :: Text -> Maybe (Text, Text) -> [ResolvedFieldIdentity] -> [Diagnostic]-wireKeyRulesForRecord owner reservedKey fields = invalidKeys <> duplicateKeys <> reservedCollisions-  where-    -- Structural safety only. An alias exists to preserve a brownfield key that-    -- the current naming convention would reject, so checking alias *style*-    -- would defeat the feature. What is checked is that the key can be a key at-    -- all: a stray space or control character in `as "family "` ships a-    -- permanently mis-keyed public field that no later rename can fix without a-    -- wire break. See ADR 0021.-    invalidKeys = concatMap invalidKeyRule fields-    invalidKeyRule field-      | T.null key = [refuse "resolves to an empty wire key"]-      | key /= T.strip key =-          [ refuse-              ( "resolves to wire key "-                  <> T.pack (show key)-                  <> ", which has leading or trailing whitespace; the wire key is the exact bytes on the wire, so the surrounding space would be part of every encoded field name"-              )-          ]-      | Just offending <- firstMatching isControl (T.unpack key) =-          [ refuse-              ( "resolves to wire key "-                  <> T.pack (show key)-                  <> ", which contains the control character U+"-                  <> T.justifyRight 4 '0' (T.toUpper (T.pack (showHex (ord offending) "")))-              )-          ]-      | otherwise = []-      where-        key = fieldWireKey field-        refuse detail =-          mkErr (locLine (fieldLoc field)) FieldWireKeyInvalid $-            owner <> " field '" <> fieldDslName field <> "' " <> detail-    duplicateKeys =-      [ Diagnostic-          { line = locLine (fieldLoc field),-            severity = Error,-            code = FieldWireKeyCollision,-            relatedLocations = [(locLine (fieldLoc earlier), "wire key '" <> fieldWireKey field <> "' is first declared here")],-            message = owner <> " fields resolve to duplicate wire key '" <> fieldWireKey field <> "'"-          }-      | (index, field) <- zip [0 :: Int ..] fields,-        earlier : _ <- [[candidate | candidate <- take index fields, fieldWireKey candidate == fieldWireKey field]]-      ]-    reservedCollisions =-      [ mkErr (locLine (fieldLoc field)) FieldWireKeyCollision $-          owner-            <> " field '"-            <> fieldDslName field-            <> "' resolves to wire key '"-            <> key-            <> "', which collides with the "-            <> description-      | Just (key, description) <- [reservedKey],-        field <- fields,-        fieldWireKey field == key+import Keiro.Dsl.SemanticContract (CheckedService, EffectiveLanguageContract (..), checkedLanguageContract, checkedProjectionSupplies, checkedSpec, checkedTypeGraph, legacyCheckedService)+import Keiro.Dsl.TypeGraph+import Keiro.Integration.Event qualified as Event+import Numeric (showHex)+import Text.Read (readMaybe)++data Severity = Error | Warning+  deriving stock (Eq, Show)++diagnosticCodeText :: DiagnosticCode -> Text+diagnosticCodeText = T.pack . show++parseDiagnosticCode :: Text -> Maybe DiagnosticCode+parseDiagnosticCode raw =+  case [diagnosticCode | diagnosticCode <- [minBound .. maxBound], diagnosticCodeText diagnosticCode == raw] of+    diagnosticCode : _ -> Just diagnosticCode+    [] -> Nothing++-- | A machine-checkable code per rule, so tests match on the code, not prose.+data DiagnosticCode+  = UndeclaredCommand+  | UndeclaredEvent+  | UndeclaredState+  | UnreachableState+  | TerminalHasOutgoing+  | GuardAtomOutOfScope+  | StatusMapNotTotal+  | ClockSampled+  | -- EP-2 (evolution). These codes are shared by single-spec validation and+    -- the cross-spec diff path, so the enum remains the single registry of+    -- evolution rules.+    EvtVersionMissingUpcaster+  | UpcasterChainGap+  | DeprecatedEventReplayHazard+  | EventRetirementInProgress+  | DeprecatedEventStillEmitted+  | WireSchemaVersionMismatch+  | EvtFieldAddedWithoutBump+  | EvtRemovedNotDeprecated+  | -- EP-3 (process manager + durable timer).+    ProcessFireAtNotInjected+  | ProcessDispatchIdSupplied+  | ProcessUnresolvedRef+  | ProcessBenignInversion+  | SagaCategoryIllegal+  | -- EP-4 (integration intake / inbox disposition).+    DispositionIncomplete+  | DispositionDuplicateRetry+  | DispositionPreviouslyFailedRetry+  | DispositionDecodeUnboundedRetry+  | -- EP-4 (integration coupling).+    EmitSkipMissing+  | EmitUnresolvedContract+  | PublisherUnresolvedEmit+  | IntakeUnresolvedContract+  | -- EP-5 (pgmq workqueue/dispatch).+    WqPhysicalDivergence+  | WqStoreFailureNotRetry+  | WqDecodeFailureNotDeadLetter+  | WqDlqWithoutCeiling+  | WqGroupKeyMissing+  | WqGroupKeyWithoutFifo+  | WqGroupKeyUnresolved+  | WqUnloggedDurability+  | WqPartitionSpecEmpty+  | SnapshotIntervalInvalid+  | SnapshotCodecFixtureInvalid+  | DispatchEnqueueUnresolved+  | -- EP-6 (workflow/operation).+    AwaitSignalMismatch+  | RunWorkflowUnresolved+  | WorkflowPatchDuplicate+  | WorkflowPatchIdInvalid+  | WorkflowContinueAsNewNotTerminal+  | -- Diff-only (cross-spec) decode and identity evolution rules.+    EvtFieldTypeChanged+  | EvtFieldRemovedSameVersion+  | EvtVersionDecreased+  | EnumCtorRemoved+  | EnumWireSpellingChanged+  | WireSpecChanged+  | ContractEventRemoved+  | ContractFieldChanged+  | ContractDiscriminatorChanged+  | ContractTopicChanged+  | ContractSchemaVersionDecreased+  | WqPayloadFieldChanged+  | ProcessInputChanged+  | WorkflowShapeChanged+  | WorkflowBodyChanged+  | WorkflowStableNameChanged+  | WorkflowPatchRemoved+  | WorkflowContinueSeedChanged+  | WqOrderingChanged+  | WqProvisionChanged+  | WqGroupKeyChanged+  | IdPrefixChanged+  | DedupeIdentityChanged+  | DerivedIdentityChanged+  | QueueIdentityChanged+  | TimerWindowChanged+  | EmitMappingChanged+  | DecodePostureChanged+  | IntakePersistenceChanged+  | ProjectionChanged+  | PublisherPolicyChanged+  | DispatchRetargeted+  | ContractSchemaVersionBumped+  | EventUndeprecated+  | -- EP-104 (validator soundness).+    WorkflowDuplicateLabel+  | WorkflowSleepDelayUnresolved+  | WorkflowIdFieldUnresolved+  | RuleDomainUnresolved+  | RuleNotTotal+  | RuleCaseUnknownCtor+  | ProcessFieldBindingUnresolved+  | ProcessTimerCeilingInvalid+  | OperationUnresolvedRef+  | AwaitSignalValueMismatch+  | WqDispositionIncomplete+  | DispositionDuplicateOutcome+  | TopicAffinityMismatch+  | StatusMapDanglingKey+  | StatusMapDuplicateKey+  | WriteTargetNotRegister+  | RegisterInitialOutOfScope+  | DuplicateNodeName+  | DuplicateEnumCtor+  | DuplicateEnumWire+  | DuplicateIdPrefix+  | DuplicateCommandName+  | DuplicateEventName+  | WqDlqDivergence+  | WqTableDivergence+  | DispatchDedupQueueUnresolved+  | DispatchDedupFieldUnresolved+  | -- EP-105 (notation integrity and scaffold-safe names).+    VertexCtorCollision+  | IdentUnsafeNormalization+  | GeneratedOccurrenceReserved+  | GeneratedOccurrenceCollision+  | -- EP-107 (first-class read models).+    RmShapeHashDrift+  | RmStrongInlineOnly+  | RmScopeWithoutStrong+  | RmUnknownColumnType+  | RmInlineFeedUnreferenced+  | RmConsistencyConflict+  | RmProjectionWithoutNode+  | QueryUnresolvedReadModel+  | QueryConsistencyInvalid+  | DispatchReadModelUnresolved+  | DispatchReadModelFieldUnknown+  | -- MasterPlan 32 / EP-4 projection catalogs.+    CatalogTargetUnknown+  | CatalogGroupUnknown+  | CatalogGroupEmpty+  | CatalogGroupOrderMismatch+  | CatalogTargetUnowned+  | CatalogTargetMultiplyOwned+  | CatalogPhysicalTargetDuplicate+  | CatalogTargetDependencyUnknown+  | CatalogTargetDependencyOutsideGroup+  | CatalogTargetDependencyCycle+  | CatalogProjectionNoSource+  | CatalogProjectionNoTarget+  | CatalogProjectionTargetOutsideGroup+  | CatalogSourceUnresolved+  | CatalogSourceOverlap+  | CatalogAmbiguousSourceOrdering+  | CatalogAsyncIdentityMissing+  | CatalogAsyncQueryBindingMissing+  | CatalogInlineIdentityUnexpected+  | CatalogCheckpointPolicyMissing+  | CatalogCheckpointPolicyDuplicate+  | CatalogCheckpointPolicyUnexpected+  | CatalogCheckpointPolicyReplayUnsafe+  | CatalogClearTargetLiveOnly+  | CatalogDuplicateHandlerOrder+  | CatalogReadModelBindingMissing+  | CatalogReadModelTargetOutsideGroup+  | CatalogReadModelPhysicalOverride+  | CatalogReadModelBackingRequired+  | CatalogReadModelBackingUnobserved+  | CatalogReadModelSupplierMissing+  | CatalogReadModelMultipleSuppliers+  | CatalogReadModelLegacyProjectionConflict+  | CatalogQueryWaitWithoutCompatibleCursor+  | CatalogQueryWaitWithAmbiguousCursor+  | CatalogTargetAdded+  | CatalogTargetRemoved+  | CatalogTargetLocationChanged+  | CatalogTargetResetPolicyChanged+  | CatalogTargetDependencyChanged+  | CatalogGroupChanged+  | CatalogRevisionNoTarget+  | CatalogRevisionGroupUnknown+  | CatalogRevisionTargetUnknown+  | CatalogRevisionTargetSetMismatch+  | CatalogRevisionIdentityInvalid+  | CatalogRevisionDuplicateTarget+  | CatalogRevisionPromotionNameInvalid+  | CatalogProjectionRevisionChanged+  | CatalogProjectionRevisionRemoved+  | CatalogTargetSchemaChanged+  | CatalogExternalReadIdentityInvalid+  | CatalogExternalReadVersionInvalid+  | CatalogExternalReadQueryUnknown+  | CatalogExternalReadTargetCardinalityInvalid+  | CatalogExternalReadCompatibilityInvalid+  | CatalogExternalReadRevisionUnknown+  | CatalogExternalReadRevisionGroupMismatch+  | CatalogExternalReadSurfaceGenerationInvalid+  | CatalogExternalReadRetired+  | CatalogExternalReadVersionAdded+  | CatalogExternalReadCompatibilityChanged+  | CatalogExternalReadResultShapeChanged+  | CatalogExternalReadContractChanged+  | CatalogOwnerChanged+  | CatalogOwnerRemoved+  | CatalogHandlerOrderChanged+  | CatalogSourceChanged+  | CatalogFeedIdentityChanged+  | CatalogCheckpointPolicyChanged+  | CatalogReplayPolicyChanged+  | CatalogQueryBindingChanged+  | ProjectionDeliveryChanged+  | QueryFreshnessChanged+  | -- EP-107 diff-only read-model evolution rules.+    ReadModelVersionDecreased+  | ReadModelShapeChangedWithoutBump+  | ReadModelFeedChanged+  | ReadModelConsistencyWeakened+  | ReadModelQueryInputChanged+  | ReadModelQueryResultChanged+  | -- EP-108 (router and worker-policy surfaces).+    RouterUnresolvedRef+  | RouterKeyFieldUnknown+  | RouterBindingUnscoped+  | RouterCommandUnknown+  | RouterReadModelUnverified+  | PolicyContradiction+  | PolicyDeadLetterUnused+  | AmbiguousMarkedBenign+  | AmbiguousFollowsRejectedPolicy+  | RouterStableNameChanged+  | -- Plan 143 (first-class replay-only transitions for guard evolution).+    -- The first two fire in single-spec @validateSpec@; the third is the+    -- diff-path guard-tightening advisory that prints the computed+    -- replay-only twin.+    ReplayOnlyEmitsNothing+  | ReplayOnlyCommandStillLive+  | AggGuardTightened+  | AggFoldSurfaceChanged+  | RouterDecideSurfaceChanged+  | ProcessDecideSurfaceChanged+  | ProcessTimerPayloadChanged+  | -- MasterPlan 25 / EP-5: append-only codes for findings that were+    -- formerly additive but uncoded.+    DeclarationAdded+  | VersionBumped+  | CompatibilityStrengthened+  | EnumCtorAdded+  | EventRetirementAbandoned+  | ContractEventAdded+  | ContractTopicAdded+  | WorkflowEvolutionGuardAdded+  | -- MasterPlan 25 / EP-149 (consumer-owned mapped types).+    MappedUnresolvedName+  | MappedAmbiguousName+  | MappedDuplicateFieldName+  | MappedDuplicateWireKey+  | MappedDuplicateArmName+  | MappedDuplicateWireTag+  | MappedNonInjectiveNullability+  | MappedRecursiveType+  | MappedUnsupportedEncoding+  | MappedMissingIngredient+  | MappedMissingInitialValue+  | MappedInvalidHaskellName+  | MappedInvalidIdentity+  | MappedImportConflict+  | MappedDefaultIllTyped+  | -- MasterPlan 25 / EP-149 mapped evolution codes.+    MappedFieldAddedWithDefault+  | MappedFieldAddedNoDefault+  | MappedFieldRemoved+  | MappedFieldTypeChanged+  | MappedPresenceChanged+  | MappedNullabilityChanged+  | MappedDefaultRemoved+  | MappedDefaultChanged+  | MappedWireKeyChanged+  | MappedUnionEncodingChanged+  | MappedArmAdded+  | MappedArmRemoved+  | MappedArmTagChanged+  | MappedEnumValueAdded+  | MappedEnumValueRemoved+  | MappedEnumSpellingChanged+  | MappedHaskellSourceChanged+  | MappedRecordConstructorChanged+  | MappedBindingChanged+  | MappedFixturesChanged+  | MappedInitialChanged+  | MappedCanonicalTypeChanged+  | MappedOpaqueCodecChanged+  | MappedModeCrossed+  | MappedDeclAdded+  | MappedDeclRemoved+  | -- MasterPlan 25 / EP-152 reporting and migration-evidence codes.+    CoverageOpaqueSurface+  | CoverageOpaqueBoundaryAdded+  | CoverageOpaqueGateExceeded+  | CodecCompareDifference+  | CodecCompareCoverageGap+  | CodecCompareInvalidInput+  | -- MasterPlan 26 / EP-153: whole-service composition refusals, emitted by+    -- "Keiro.Dsl.Workspace" when several @.keiro@ members are composed into+    -- one service graph. They live in this registry, not a parallel enum, so+    -- every gate stays correlatable by code (ADR 0004). Manifest syntax and+    -- structure errors deliberately have no code here: like a @.keiro@ parse+    -- error, they are refused before any graph exists to diagnose.+    WorkspaceMemberUnreadable+  | WorkspaceMemberParseFailed+  | WorkspaceContextMismatch+  | WorkspaceAuthorityConflict+  | WorkspaceDuplicateDeclaration+  | WorkspaceDuplicateNodeName+  | WorkspacePathCollision+  | WorkspaceSourceIndexInvalid+  | -- MasterPlan 26 / EP-155: whole-workspace diff facts. These are+    -- advisory consumer-build obligations, distinct from wire evolution.+    OwnershipMoved+  | WorkspaceAuthorityChanged+  | -- EP-157: canonical aggregate type resolution and capabilities.+    AggregateTypeUnknown+  | AggregateTypeUnsupportedAtUse+  | AggregateRegisterInitialInvalid+  | AggregateGuardTypeMismatch+  | AggregateGuardCapabilityUnsupported+  | AggregateExpressionRootUnknown+  | AggregateExpressionRootAmbiguous+  | AggregateExpressionPathInvalid+  | AggregateExpressionPathUnsupported+  | AggregateExpressionLiteralNeedsType+  | AggregateExpressionLiteralInvalid+  | AggregateExpressionOperandTypeMismatch+  | AggregateExpressionOperatorUnsupported+  | AggregateExpressionBooleanRequired+  | AggregateExpressionGuardBoolRequired+  | AggregateExpressionWriteTargetUnknown+  | AggregateExpressionWriteTypeMismatch+  | AggregateTransitionOwnershipConflict+  | DomainOutcomeDeclarationMissing+  | DomainOutcomeDeclarationDuplicate+  | DomainOutcomeTypeUnresolved+  | DomainOutcomeClauseMissing+  | DomainOutcomeClauseDuplicate+  | DomainOutcomeReasonTypeMismatch+  | DomainOutcomeAcceptedWithoutEvents+  | DomainOutcomeSilentEmits+  | DomainOutcomeSilentWrites+  | DomainOutcomeSilentStateChange+  | DomainOutcomeReplayOnlyClause+  | DomainOutcomeTypesChanged+  | DomainTransitionOutcomeChanged+  | CollectionExpressionUnsupported+  | -- EP-160: append-only source-language composition and diff facts.+    WorkspaceLanguageVersionMismatch+  | SourceLanguageDeclarationChanged+  | -- EP-158: checked consumer-owned nominal IDs, enums, and scalars.+    NominalMissingIngredient+  | NominalInvalidHaskellSource+  | NominalInvalidQualifiedName+  | NominalInvalidIdentity+  | NominalInvalidIdPrefix+  | NominalUnsupportedRepresentation+  | NominalEmptyEnumRepresentation+  | NominalMissingInitialValue+  | NominalNameCollision+  | NominalBindingChanged+  | NominalFixturesChanged+  | NominalCanonicalTypeChanged+  | NominalInitialChanged+  | NominalRepresentationChanged+  | NominalIdDecoderTightened+  | -- ExecPlan 171 / IR-14: versioned prefix-bearing ID admission policy.+    IdDomainContractChanged+  | -- ExecPlan 159 / IR-13: @fields(Command)@ output authority.+    EventOutputCommandMismatch+  | AggregateEventlessStateChange+  | -- ExecPlan 178: language-4 integration contract TypeID admission.+    ContractInvalidTypeIdPrefix+  | ContractTypeIdDomainChanged+  | -- ExecPlan 180: accepted-but-unenforced spec surfaces.+    PublisherOrderingUnknown+  | PublisherBackoffInvalid+  | IntakeDedupePolicyUnknown+  | PublisherMaxAttemptsBelowMinimum+  | ContractSchemaVersionBelowMinimum+  | ReadModelVersionBelowMinimum+  | IntakeDecodeSchemaVersionBelowMinimum+  | AggregateDuplicateFieldName+  | ContractDuplicateFieldName+  | ContractFieldShadowsDiscriminator+  | TransitionDuplicateUnguarded+  | ContractDuplicateEvent+  | ContractDuplicateTopicAlias+  | AggregateDuplicateState+  | AggregateDuplicateRegister+  | NominalDuplicateDeclaration+  | EmitMapDuplicateCase+  | TransitionUnguardedSibling+  | RuntimeIdentityInvalid+  | RuntimeIdentityDuplicate+  | ContractTopicNameInvalid+  | ReadModelIdentifierInvalid+  | ReadModelDuplicateColumn+  | IntakeBindUnresolved+  | IntakeDedupeKeyUnresolved+  | IntakeEnvelopePolicyUnknown+  | IntakeDecodeSchemaVersionMismatch+  | ContractTopicAliasUnresolved+  | WireClauseUnsupported+  | -- ExecPlan 190: an unchanged semantic/external declaration now presents a+    -- different generated Haskell occurrence.+    GeneratedHaskellNameChanged+  | -- ExecPlan 192: resolved field wire identities are checked before lowering.+    FieldWireKeyCollision+  | FieldWireKeyInvalid+  | -- ExecPlan 192: changing an aggregate event field's resolved wire key+    -- changes the persisted event decode surface.+    EvtFieldWireKeyChanged+  | -- ExecPlan 193: a CI-required released language floor was not met.+    LanguageVersionBelowMinimum+  | -- ExecPlan 194: scaffold's empty-node refusals are reported by check at+    -- the owning declaration before planning begins.+    AggregateEmpty+  | ContractEmpty+  | -- ExecPlan 194: pure scaffold-planning gates share check's located,+    -- machine-readable diagnostic pipeline.+    GeneratedPathCollision+  | GeneratedImportCycle+  | BehaviorDerivationInvalid+  | BehaviorSourceAnchorMissing+  | BehaviorSourceAnchorInexact+  | BehaviorSourceAnchorCollision+  | ConformanceFactKeyCollision+  | GeneratedPlanningInvariantViolation+  | -- ExecPlan 197: accepted but currently inert spec surfaces are reported+    -- through the ordinary warning pipeline.+    IntakeBindFlagUnenforced+  | RmInlineSubscriptionIgnored+  | -- ExecPlan 197: process and router references close under language 4.+    ProcessKeyFieldUnknown+  | ProcessDispatchKeyUnresolved+  | ProcessBindingUnscoped+  | -- ExecPlan 197: remaining accepted surfaces close under language 4.+    WqPayloadTypeUnknown+  | WindowOutOfRange+  | TimerIdFieldNotCorrelation+  | AggProjectionKeyUnresolved+  | PublisherOutboxFieldUnresolved+  | RouterBenignInversion+  | -- ExecPlan 199: spellings the grammar accepts that no runtime implements.+    -- Each names one concrete runtime fact the declaration contradicts, warns on+    -- released languages below 4, and errors from language 4 on.+    DecodeBodyPostureUnsupported+  | DispatchOnAppendedUnsupported+  | TimerNotMineUnsupported+  | IntakeBindHeaderUnknown+  | -- ExecPlan 199: the surfaces ExecPlan 197 parked as descriptive-only, closed+    -- by checking the reference each one actually names.+    TimerDecodeStatusUnknown+  | TimerDeadLetterTextInvalid+  | PgmqFanoutFunctionInvalid+  | -- MasterPlan 35 / EP-1: candidate typed surfaces remain fail-closed until+    -- their complete lowering plans land.+    MappedQueueLoweringPending+  | MappedReadModelLoweringPending+  | RouterSelectionNotDeclarative+  | RouterSelectionCapabilityUnavailable+  | RouterSelectionIdentityEmpty+  | RouterSelectionVersionInvalid+  | RouterSelectionQueryUnknown+  | RouterSelectionQueryContractMissing+  | RouterSelectionQueryInputBindingInvalid+  | RouterSelectionQueryInputTypeMismatch+  | RouterSelectionQueryResultNotList+  | RouterSelectionQueryRowNotStructural+  | RouterSelectionExpressionRootUnknown+  | RouterSelectionExpressionFieldUnknown+  | RouterSelectionExpressionFieldOptional+  | RouterSelectionExpressionTypeMismatch+  | RouterSelectionPredicateNotBool+  | RouterSelectionRecipientNotText+  | RouterSelectionOperatorUnsupported+  | RouterSelectionRecipientLimitMissing+  | RouterSelectionRecipientLimitInvalid+  | RouterSelectionOrderUnsupported+  | RouterSelectionDedupeUnsupported+  | RouterSelectionFailureAckForbidden+  | RouterSelectionRedeliveryUnsupported+  | RouterSelectionPartialDispatchUnsupported+  | RouterSelectionTargetAmbiguous+  | RouterSelectionCommandUnknown+  | RouterSelectionCommandMappingDuplicate+  | RouterSelectionCommandMappingIncomplete+  | RouterSelectionCommandMappingTypeMismatch+  deriving stock (Eq, Ord, Show, Enum, Bounded)++-- | Which command pipeline can actually produce a given 'DiagnosticCode'.+--+-- The registry exists so a CI warning policy cannot silently name a code the+-- selected command never emits. Before ExecPlan 199, @keiro-dsl check --deny+-- EvtFieldWireKeyChanged@ was accepted and then matched nothing forever,+-- because that code is only reachable from @diff@'s cross-revision comparison.+data DiagnosticOrigin+  = -- | Reachable from @check@ on a single spec or a workspace. This includes+    -- the pure scaffold-planning gates that @check@ replays, and it is the+    -- default for any code not positively classified below.+    CheckDiagnostic+  | -- | Reachable only from the structural-coverage pass, which runs only when+    -- @--coverage-report@ is supplied.+    CoverageDiagnostic+  | -- | Reachable only from @diff@, which compares two revisions of a spec.+    -- Nothing in a single-revision @check@ can produce these.+    DiffDiagnostic+  | -- | Reachable only from the generated codec-comparison path, which no+    -- @check@ or @diff@ invocation runs.+    CodecCompareDiagnostic+  deriving stock (Eq, Ord, Show, Enum, Bounded)++-- | Classify a code by the pipeline that emits it.+--+-- Only codes proven non-@check@ are listed; everything else falls through to+-- 'CheckDiagnostic'. The default is deliberately the permissive one: a+-- misclassification here would reject a working CI invocation, whereas falling+-- through merely preserves the pre-199 behavior of accepting the code.+diagnosticOrigin :: DiagnosticCode -> DiagnosticOrigin+diagnosticOrigin diagnosticCode = case diagnosticCode of+  -- Structural coverage, reachable from `check --coverage-report`.+  CoverageOpaqueSurface -> CoverageDiagnostic+  CoverageOpaqueGateExceeded -> CoverageDiagnostic+  -- Coverage delta, computed only against a previous revision.+  CoverageOpaqueBoundaryAdded -> DiffDiagnostic+  -- Generated codec comparison.+  CodecCompareDifference -> CodecCompareDiagnostic+  CodecCompareCoverageGap -> CodecCompareDiagnostic+  CodecCompareInvalidInput -> CodecCompareDiagnostic+  -- Cross-revision evolution facts.+  AggFoldSurfaceChanged -> DiffDiagnostic+  AggGuardTightened -> DiffDiagnostic+  DomainOutcomeTypesChanged -> DiffDiagnostic+  DomainTransitionOutcomeChanged -> DiffDiagnostic+  CompatibilityStrengthened -> DiffDiagnostic+  ContractDiscriminatorChanged -> DiffDiagnostic+  ContractEventAdded -> DiffDiagnostic+  ContractEventRemoved -> DiffDiagnostic+  ContractFieldChanged -> DiffDiagnostic+  ContractSchemaVersionBumped -> DiffDiagnostic+  ContractSchemaVersionDecreased -> DiffDiagnostic+  ContractTopicAdded -> DiffDiagnostic+  ContractTopicChanged -> DiffDiagnostic+  ContractTypeIdDomainChanged -> DiffDiagnostic+  DeclarationAdded -> DiffDiagnostic+  DecodePostureChanged -> DiffDiagnostic+  DedupeIdentityChanged -> DiffDiagnostic+  DerivedIdentityChanged -> DiffDiagnostic+  DispatchRetargeted -> DiffDiagnostic+  EmitMappingChanged -> DiffDiagnostic+  EnumCtorAdded -> DiffDiagnostic+  EnumCtorRemoved -> DiffDiagnostic+  EnumWireSpellingChanged -> DiffDiagnostic+  EventRetirementAbandoned -> DiffDiagnostic+  EventUndeprecated -> DiffDiagnostic+  EvtFieldAddedWithoutBump -> DiffDiagnostic+  EvtFieldRemovedSameVersion -> DiffDiagnostic+  EvtFieldTypeChanged -> DiffDiagnostic+  EvtFieldWireKeyChanged -> DiffDiagnostic+  EvtRemovedNotDeprecated -> DiffDiagnostic+  EvtVersionDecreased -> DiffDiagnostic+  GeneratedHaskellNameChanged -> DiffDiagnostic+  IdDomainContractChanged -> DiffDiagnostic+  IdPrefixChanged -> DiffDiagnostic+  IntakePersistenceChanged -> DiffDiagnostic+  MappedArmAdded -> DiffDiagnostic+  MappedArmRemoved -> DiffDiagnostic+  MappedArmTagChanged -> DiffDiagnostic+  MappedBindingChanged -> DiffDiagnostic+  MappedCanonicalTypeChanged -> DiffDiagnostic+  MappedDeclAdded -> DiffDiagnostic+  MappedDeclRemoved -> DiffDiagnostic+  MappedDefaultChanged -> DiffDiagnostic+  MappedDefaultRemoved -> DiffDiagnostic+  MappedEnumSpellingChanged -> DiffDiagnostic+  MappedEnumValueAdded -> DiffDiagnostic+  MappedEnumValueRemoved -> DiffDiagnostic+  MappedFieldAddedNoDefault -> DiffDiagnostic+  MappedFieldAddedWithDefault -> DiffDiagnostic+  MappedFieldRemoved -> DiffDiagnostic+  MappedFieldTypeChanged -> DiffDiagnostic+  MappedFixturesChanged -> DiffDiagnostic+  MappedHaskellSourceChanged -> DiffDiagnostic+  MappedInitialChanged -> DiffDiagnostic+  MappedModeCrossed -> DiffDiagnostic+  MappedNullabilityChanged -> DiffDiagnostic+  MappedOpaqueCodecChanged -> DiffDiagnostic+  MappedPresenceChanged -> DiffDiagnostic+  MappedRecordConstructorChanged -> DiffDiagnostic+  MappedUnionEncodingChanged -> DiffDiagnostic+  MappedWireKeyChanged -> DiffDiagnostic+  NominalBindingChanged -> DiffDiagnostic+  NominalCanonicalTypeChanged -> DiffDiagnostic+  NominalFixturesChanged -> DiffDiagnostic+  NominalIdDecoderTightened -> DiffDiagnostic+  NominalInitialChanged -> DiffDiagnostic+  NominalRepresentationChanged -> DiffDiagnostic+  OwnershipMoved -> DiffDiagnostic+  ProcessDecideSurfaceChanged -> DiffDiagnostic+  ProcessInputChanged -> DiffDiagnostic+  ProcessTimerPayloadChanged -> DiffDiagnostic+  ProjectionChanged -> DiffDiagnostic+  PublisherPolicyChanged -> DiffDiagnostic+  QueueIdentityChanged -> DiffDiagnostic+  ReadModelConsistencyWeakened -> DiffDiagnostic+  ReadModelFeedChanged -> DiffDiagnostic+  ReadModelQueryInputChanged -> DiffDiagnostic+  ReadModelQueryResultChanged -> DiffDiagnostic+  ReadModelShapeChangedWithoutBump -> DiffDiagnostic+  ReadModelVersionDecreased -> DiffDiagnostic+  RouterDecideSurfaceChanged -> DiffDiagnostic+  RouterStableNameChanged -> DiffDiagnostic+  SourceLanguageDeclarationChanged -> DiffDiagnostic+  TimerWindowChanged -> DiffDiagnostic+  VersionBumped -> DiffDiagnostic+  WireSpecChanged -> DiffDiagnostic+  WorkflowBodyChanged -> DiffDiagnostic+  WorkflowContinueSeedChanged -> DiffDiagnostic+  WorkflowEvolutionGuardAdded -> DiffDiagnostic+  WorkflowPatchRemoved -> DiffDiagnostic+  WorkflowShapeChanged -> DiffDiagnostic+  WorkflowStableNameChanged -> DiffDiagnostic+  WorkspaceAuthorityChanged -> DiffDiagnostic+  WqGroupKeyChanged -> DiffDiagnostic+  WqOrderingChanged -> DiffDiagnostic+  WqPayloadFieldChanged -> DiffDiagnostic+  WqProvisionChanged -> DiffDiagnostic+  _ -> CheckDiagnostic++-- | A line-numbered, structured diagnostic.+data Diagnostic = Diagnostic+  { line :: !Int,+    severity :: !Severity,+    code :: !DiagnosticCode,+    relatedLocations :: ![(Int, Text)],+    message :: !Text+  }+  deriving stock (Eq, Show)++-- | Render a diagnostic in the conventional+-- @\<file\>:\<line\>: error[\<code\>]: \<message\>@ form.+renderDiagnostic :: FilePath -> Diagnostic -> Text+renderDiagnostic file d =+  T.intercalate "\n" (primary : notes)+  where+    primary =+      T.pack file+        <> ":"+        <> T.pack (show ((.line) d))+        <> ": "+        <> sev+        <> "["+        <> T.pack (show ((.code) d))+        <> "]: "+        <> (.message) d+    notes =+      [ "  " <> T.pack file <> ":" <> T.pack (show noteLine) <> ": note: " <> note+      | (noteLine, note) <- (.relatedLocations) d+      ]+    sev = case (.severity) d of Error -> "error"; Warning -> "warning"++-- | Error diagnostics produced when the effective source language is below a+-- CI-required released floor. A legacy source has no preamble, so line 1 is the+-- actionable location where one should be added.+minimumLanguageDiagnostics :: LanguageVersion -> SourceLanguage -> [Diagnostic]+minimumLanguageDiagnostics floorVersion sourceLanguage+  | effectiveVersion >= floorVersion = []+  | otherwise =+      [ Diagnostic+          { line = sourceLanguageLine sourceLanguage,+            severity = Error,+            code = LanguageVersionBelowMinimum,+            relatedLocations = [],+            message =+              "effective language version "+                <> languageVersionText effectiveVersion+                <> " ("+                <> sourceFormText sourceLanguage+                <> ") is below the required minimum "+                <> languageVersionText floorVersion+                <> "; declare `language keiro-dsl "+                <> languageVersionText floorVersion+                <> "`"+          }+      ]+  where+    effectiveVersion = effectiveLanguageVersion sourceLanguage+    sourceLanguageLine LegacyUnversioned = 1+    sourceLanguageLine DeclaredLanguage {languageVersionLoc = Loc lineNumber} = lineNumber++-- | Reserved wall-clock atom names. Sampling any of these inside a guard or+-- write breaks deterministic replay: TIME IS INJECTED, NOT SAMPLED.+clockAtoms :: Set Name+clockAtoms = Set.fromList ["now", "currentTime", "wallClock", "today", "utcNow"]++-- | Validate a whole service under its effective released semantic contract.+-- An empty list means valid. Current released versions share this policy, but+-- selecting it at this boundary prevents successor semantics from being lost.+validateService :: CheckedService -> [Diagnostic]+validateService service =+  validateCheckedSpec+    (checkedLanguageContract service)+    (checkedTypeGraph service)+    (checkedProjectionSupplies service)+    (checkedSpec service)++-- | Compatibility wrapper for callers that have only a normalized graph. It+-- explicitly selects legacy/version-1 semantics; production source/workspace+-- routes use 'validateService'.+validateSpec :: Spec -> [Diagnostic]+validateSpec = validateService . legacyCheckedService++validateCheckedSpec :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> ProjectionSupplyAnalysis -> Spec -> [Diagnostic]+validateCheckedSpec languageContract typeGraphResult supplyAnalysis spec =+  sortOn (.line) (validateNames languageContract typeGraphResult spec ++ validateMapped typeGraphResult spec ++ validateNominal languageContract spec ++ validateAggregateTypes typeGraphResult spec ++ specLevelRules languageContract supplyAnalysis spec ++ concatMap (validateNode languageContract typeGraphResult supplyAnalysis spec) ((.nodes) spec))++-- | Rules added before language 4 ships consult the effective semantic+-- contract, not the numeric source spelling. Versions 1 through 3 retain their+-- released acceptance; runtime semantics 3 is the unreleased tightening gate.+enforcesSpecSurfaceClosures :: EffectiveLanguageContract -> Bool+enforcesSpecSurfaceClosures languageContract =+  runtimeProfileHasCapability ((.runtimeProfile) languageContract) StrictSpecSurfaceValidation++hasProjectionCatalog :: EffectiveLanguageContract -> Bool+hasProjectionCatalog languageContract =+  runtimeProfileHasCapability ((.runtimeProfile) languageContract) ProjectionCatalogRuntime++hasSeparatedProjectionQueryPolicy :: EffectiveLanguageContract -> Bool+hasSeparatedProjectionQueryPolicy languageContract =+  runtimeProfileHasCapability ((.runtimeProfile) languageContract) SeparatedProjectionQueryPolicy++validateNominal :: EffectiveLanguageContract -> Spec -> [Diagnostic]+validateNominal languageContract spec = domainErrors <> resolutionErrors+  where+    domainErrors =+      [ mkErr (locLine ((.loc) declaration)) NominalInvalidIdPrefix $+          "id '" <> (.name) declaration <> "' has invalid TypeID prefix '" <> (.prefix) declaration <> "': " <> T.pack (show reason)+      | declaration <- (.ids) spec,+        Just _ <- [idDomainContractFor languageContract ((.prefix) declaration)],+        Just reason <- [TypeID.checkPrefix ((.prefix) declaration)]+      ]+    resolutionErrors = case Nominal.resolveNominalTypes spec of+      Right _ -> []+      Left errors -> map nominalTypeDiagnostic (NE.toList errors)++nominalTypeDiagnostic :: Nominal.NominalTypeError -> Diagnostic+nominalTypeDiagnostic nominalError = case nominalError of+  Nominal.NominalMissingIngredient name loc ingredient ->+    problem loc NominalMissingIngredient $ "nominal declaration '" <> name <> "' is missing required " <> ingredient <> " provenance"+  Nominal.NominalInvalidHaskellSource name loc ingredient ->+    problem loc NominalInvalidHaskellSource $ "nominal declaration '" <> name <> "' has an invalid Haskell " <> ingredient <> " name"+  Nominal.NominalInvalidQualifiedValue name loc ingredient value ->+    problem loc NominalInvalidQualifiedName $+      "nominal declaration '" <> name <> "' has invalid " <> ingredient <> " symbol '" <> value <> "'; expected a module path plus a lower-initial value"+  Nominal.NominalInvalidIdentity name loc ingredient value ->+    problem loc NominalInvalidIdentity $ "nominal declaration '" <> name <> "' has invalid " <> ingredient <> " '" <> value <> "'"+  Nominal.NominalInvalidIdPrefix name loc prefix detail ->+    problem loc NominalInvalidIdPrefix $ "id '" <> name <> "' has invalid TypeID prefix '" <> prefix <> "': " <> detail+  Nominal.NominalUnsupportedScalar name loc representation ->+    problem loc NominalUnsupportedRepresentation $+      "nominal scalar '" <> name <> "' uses unsupported representation '" <> representation <> "'; supported representations are Text, Int, Natural, Bool, and Time"+  Nominal.NominalEmptyEnum name loc ->+    problem loc NominalEmptyEnumRepresentation $ "enum '" <> name <> "' must declare at least one closed representation constructor"+  Nominal.NominalMissingRegisterInitial name loc registerName ->+    problem loc NominalMissingInitialValue $+      "consumer-owned nominal type '" <> name <> "' is used by register '" <> registerName <> "' and must name an initial symbol"+  Nominal.NominalDeclarationCollision name loc categories ->+    problem loc NominalNameCollision $ "declaration name '" <> name <> "' collides across " <> T.intercalate ", " categories+  where+    problem loc diagnosticCode detail = mkErr (locLine loc) diagnosticCode (detail <> "; GHC and conformance validate consumer function bodies")++-- | Resolve every direct aggregate type once at the earliest semantic gate.+validateAggregateTypes :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]+validateAggregateTypes typeGraphResult spec = case Nominal.resolveNominalTypes spec of+  Left _ -> []+  Right _ -> concatMap aggregateRules aggregates+  where+    symbols = aggregateSymbolsFromGraphResult typeGraphResult spec+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]++    aggregateRules aggregate =+      outcomeTypeRules aggregate+        ++ concatMap commandRules ((.commands) aggregate)+        ++ concatMap eventRules ((.events) aggregate)+        ++ concatMap registerRules ((.regs) aggregate)+        ++ concatMap (transitionRules aggregate) ((.transitions) aggregate)+      where+        commandRules command = concatMap (fieldRule aggregate CommandFieldUse) ((.fields) command)+        eventRules event = case (.body) event of+          EventFields fields -> concatMap (fieldRule aggregate EventFieldUse) fields+          EventFromCommand _ -> []+        registerRules register = case resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register) of+          Left typeError -> [aggregateTypeDiagnostic typeError]+          Right AggregateMapped {} -> []+          Right resolved -> case resolveRegisterInitial symbols ((.loc) register) resolved ((.initial) register) of+            Left initialError -> [aggregateTypeDiagnostic initialError]+            Right _ -> []++    fieldRule aggregate useSite field =+      either (pure . aggregateTypeDiagnostic) (const []) (inferAggregateFieldType symbols aggregate useSite field)++    outcomeTypeRules aggregate = case (.domainOutcomeTypes) aggregate of+      Nothing -> []+      Just declaration ->+        unresolved "rejection" ((.rejectionType) declaration)+          ++ unresolved "no-op" ((.noOpType) declaration)+        where+          unresolved label name = case resolveAggregateType symbols ((.outcomeTypesLoc) declaration) HaskellLoweringUse (TRef name) of+            Right _ -> []+            Left _ ->+              [ mkErr (locLine ((.outcomeTypesLoc) declaration)) DomainOutcomeTypeUnresolved $+                  "aggregate '" <> (.name) aggregate <> "' declares unknown or unsupported " <> label <> " outcome type '" <> name <> "'"+              ]++    transitionRules aggregate transition = ownershipRules ++ outcomeExpressionRules+      where+        environment = expressionEnvironmentFromGraphResult typeGraphResult spec aggregate transition+        ownershipRules = case (.implementation) transition of+          LegacyHoleImplementation ->+            concatMap (comparisonRule aggregate transition) (maybe [] comparisons ((.guard) transition))+          GeneratedImplementation ->+            maybe [] (expressionDiagnostics . resolveGuardExpr environment) ((.guard) transition)+              ++ concatMap (expressionDiagnostics . uncurry (resolveWriteExpr environment)) ((.writes) transition)+          HoleImplementation ->+            [ mkErr (locLine ((.loc) transition)) AggregateTransitionOwnershipConflict $+                "transition '"+                  <> (.source) transition+                  <> " -- "+                  <> (.command) transition+                  <> "' selects implementation hole and therefore cannot also declare guard or write clauses"+            | (.guard) transition /= Nothing || not (null ((.writes) transition))+            ]+        outcomeExpressionRules = case ((.domainOutcomeTypes) aggregate, (.outcome) transition) of+          (Just declaration, Just (OutcomeRejected expression _)) -> resolveReason "rejected" ((.rejectionType) declaration) expression+          (Just declaration, Just (OutcomeNoOp expression _)) -> resolveReason "no-op" ((.noOpType) declaration) expression+          _ -> []+        resolveReason label typeName expression =+          case resolveAggregateType symbols ((.outcomeTypesLoc) declaration) HaskellLoweringUse (TRef typeName) of+            Left _ -> []+            Right expected ->+              case resolveScalarExpr environment (ExpectScalarType expected) expression of+                Right _ -> []+                Left diagnostics -> map (outcomeExpressionDiagnostic label . id) (NE.toList diagnostics)+          where+            declaration = case (.domainOutcomeTypes) aggregate of+              Just value -> value+              Nothing -> error "unreachable: outcome reason without declaration"++    outcomeExpressionDiagnostic label diagnostic =+      mkErr+        (locLine ((.loc) diagnostic))+        ( if (.code) diagnostic `elem` [ScalarOperandTypeMismatch, ScalarBooleanOperandRequired]+            then DomainOutcomeReasonTypeMismatch+            else expressionCode ((.code) diagnostic)+        )+        ("typed " <> label <> " outcome reason is invalid: " <> (.message) diagnostic)++    expressionDiagnostics = either (map expressionDiagnostic . NE.toList) (const [])++    expressionDiagnostic diagnostic =+      mkErr+        (locLine ((.loc) diagnostic))+        (expressionCode ((.code) diagnostic))+        ((.message) diagnostic)++    expressionCode = \case+      ScalarRootUnknown -> AggregateExpressionRootUnknown+      ScalarRootAmbiguous -> AggregateExpressionRootAmbiguous+      ScalarPathInvalid -> AggregateExpressionPathInvalid+      ScalarPathUnsupported -> AggregateExpressionPathUnsupported+      ScalarLiteralNeedsType -> AggregateExpressionLiteralNeedsType+      ScalarLiteralInvalid -> AggregateExpressionLiteralInvalid+      ScalarOperandTypeMismatch -> AggregateExpressionOperandTypeMismatch+      ScalarOperatorUnsupported -> AggregateExpressionOperatorUnsupported+      ScalarBooleanOperandRequired -> AggregateExpressionBooleanRequired+      ScalarGuardBoolRequired -> AggregateExpressionGuardBoolRequired+      ScalarWriteTargetUnknown -> AggregateExpressionWriteTargetUnknown+      ScalarWriteTypeMismatch -> AggregateExpressionWriteTypeMismatch++    comparisonRule aggregate transition (operator, left, right) =+      case (expressionType aggregate transition left, expressionType aggregate transition right) of+        (Right leftType, Right rightType)+          | leftType /= rightType ->+              [ mkErr (locLine ((.loc) transition)) AggregateGuardTypeMismatch $+                  "comparison operands have different aggregate types '"+                    <> aggregateCanonicalName leftType+                    <> "' and '"+                    <> aggregateCanonicalName rightType+                    <> "'"+              ]+          | aggregateCapability useSite leftType == Unsupported ->+              [ mkErr (locLine ((.loc) transition)) AggregateGuardCapabilityUnsupported $+                  renderAggregateUseSite useSite+                    <> " is unsupported for aggregate type '"+                    <> aggregateCanonicalName leftType+                    <> "'"+              ]+          | otherwise -> []+        _ -> []+      where+        useSite = case operator of+          OpEq -> EqualityGuardUse+          OpNeq -> EqualityGuardUse+          OpLt -> OrderingGuardUse+          OpLe -> OrderingGuardUse+          OpGt -> OrderingGuardUse+          OpGe -> OrderingGuardUse++    expressionType aggregate transition expression = case expression of+      EAtom (ABool _) -> pure AggregateBool+      EAtom (AName name) -> atomType aggregate transition name+      EOr {} -> pure AggregateBool+      EAnd {} -> pure AggregateBool+      ECmp {} -> pure AggregateBool+      EAdd _ left _ -> expressionType aggregate transition left+      ESubtract _ left _ -> expressionType aggregate transition left+      EMultiply _ left _ -> expressionType aggregate transition left+      EPath loc _ path -> case path of+        name : _ -> atomType aggregate transition name+        [] -> Left (AggregateTypeError loc EqualityGuardUse (UnknownAggregateType "<empty-path>"))+      ELiteral _ literal -> case literal of+        LiteralBool {} -> pure AggregateBool+        LiteralText {} -> pure AggregateText+        LiteralIntegral {} -> Left (AggregateTypeError (exprLoc expression) EqualityGuardUse (UnknownAggregateType "<contextual-integral-literal>"))+        LiteralQualified typeName _ -> resolveAggregateType symbols (exprLoc expression) EqualityGuardUse (TRef typeName)+        LiteralId typeName _ -> resolveAggregateType symbols (exprLoc expression) EqualityGuardUse (TRef typeName)++    atomType aggregate transition name = case [register | register <- (.regs) aggregate, (.name) register == name] of+      register : _ -> resolveAggregateType symbols ((.loc) register) RegisterUse ((.valueType) register)+      [] -> case [field | command <- (.commands) aggregate, (.name) command == (.command) transition, field <- (.fields) command, (.name) field == name] of+        field : _ -> inferAggregateFieldType symbols aggregate CommandFieldUse field+        [] -> case [(.name) declaration | declaration <- (.enums) spec, name `elem` map fst ((.ctors) declaration)] of+          enumType : _ -> resolveAggregateType symbols ((.loc) transition) CommandFieldUse (TRef enumType)+          []+            | name `elem` map (.name) ((.states) aggregate) -> pure (AggregateVertex ((.name) aggregate <> "Vertex"))+            | Just rule <- firstMatching ((== name) . (.name)) ((.rules) spec) ->+                resolveAggregateType symbols ((.loc) rule) EqualityGuardUse (nameTypeExpr ((.codomain) rule))+            | otherwise -> Left (AggregateTypeError ((.loc) transition) EqualityGuardUse (UnknownAggregateType name))++    nameTypeExpr name = case name of+      "Text" -> TText+      "Int" -> TInt+      "Bool" -> TBool+      "Natural" -> TNatural+      "Time" -> TTime+      "UTCTime" -> TTime+      "Json" -> TJson+      _ -> TRef name++    comparisons expression = case expression of+      EOr left right -> comparisons left <> comparisons right+      EAnd left right -> comparisons left <> comparisons right+      ECmp operator left right -> (operator, left, right) : comparisons left <> comparisons right+      EAdd _ left right -> comparisons left <> comparisons right+      ESubtract _ left right -> comparisons left <> comparisons right+      EMultiply _ left right -> comparisons left <> comparisons right+      EPath {} -> []+      ELiteral {} -> []+      EAtom {} -> []++aggregateTypeDiagnostic :: AggregateTypeError -> Diagnostic+aggregateTypeDiagnostic aggregateError =+  mkErr (locLine ((.loc) aggregateError)) diagnosticCode diagnosticMessage+  where+    diagnosticCode = case (.reason) aggregateError of+      UnknownAggregateType {} -> AggregateTypeUnknown+      UnsupportedAggregateShape {} -> AggregateTypeUnsupportedAtUse+      UnsupportedAggregateCapability {} -> case (.useSite) aggregateError of+        EqualityGuardUse -> AggregateGuardCapabilityUnsupported+        OrderingGuardUse -> AggregateGuardCapabilityUnsupported+        _ -> AggregateTypeUnsupportedAtUse+      InvalidRegisterInitial {} -> AggregateRegisterInitialInvalid+    diagnosticMessage = case (.reason) aggregateError of+      UnknownAggregateType name ->+        "unknown aggregate type '" <> name <> "' at " <> renderAggregateUseSite ((.useSite) aggregateError)+      UnsupportedAggregateShape expression ->+        "direct aggregate type '"+          <> typeExprCanonicalName expression+          <> "' is unsupported at "+          <> renderAggregateUseSite ((.useSite) aggregateError)+          <> "; use a mapped structural declaration for Json or container shapes"+      UnsupportedAggregateCapability resolved ->+        renderAggregateUseSite ((.useSite) aggregateError)+          <> " is unsupported for aggregate type '"+          <> aggregateCanonicalName resolved+          <> "'"+      InvalidRegisterInitial resolved detail ->+        "invalid " <> aggregateCanonicalName resolved <> " register initial: " <> detail++renderAggregateUseSite :: AggregateUseSite -> Text+renderAggregateUseSite useSite = case useSite of+  CommandFieldUse -> "command field"+  EventFieldUse -> "event field"+  RegisterUse -> "register"+  EqualityGuardUse -> "equality guard"+  OrderingGuardUse -> "ordering guard"+  WholeValueWriteUse -> "whole-value write"+  CodecUse -> "JSON codec"+  SnapshotUse -> "snapshot"+  HarnessSampleUse -> "harness sample"+  HaskellLoweringUse -> "Haskell lowering"++-- | Validate consumer-owned mapped declarations without inspecting consumer+-- Haskell. Symbol-shaped facts are checked lexically here; GHC remains the+-- authority for whether the named packages, modules, values, types, and+-- instances actually exist with the promised types.+validateMapped :: Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]+validateMapped typeGraphResult spec =+  mappedLexicalRules spec+    ++ mappedIdentityRules spec+    ++ mappedConflictRules spec+    ++ case typeGraphResult of+      Left errors -> concatMap (typeGraphDiagnostic spec) (NE.toList errors)+      Right graph -> mappedGraphRules spec graph++typeGraphDiagnostic :: Spec -> TypeGraphError -> [Diagnostic]+typeGraphDiagnostic spec = \case+  TGDeclError name declarationError ->+    [ mkErr (mappedLine spec name) diagnosticCode $+        "mapped declaration '" <> name <> "': " <> declarationErrorMessage declarationError+    ]+    where+      diagnosticCode = case declarationError of+        MissingHaskellSource {} -> MappedMissingIngredient+        MissingStructuralBinding {} -> MappedMissingIngredient+        MissingStructuralBindingVersion {} -> MappedMissingIngredient+        MissingCanonicalType {} -> MappedMissingIngredient+        MissingFixtureCases {} -> MappedMissingIngredient+        MissingOpaqueCodecIdentity {} -> MappedMissingIngredient+        MissingOpaqueCodecVersion {} -> MappedMissingIngredient+        EmptyQualifiedValueName {} -> MappedInvalidHaskellName+        EmptyCanonicalTypeId {} -> MappedInvalidIdentity+        EmptyBindingVersion {} -> MappedInvalidIdentity+        EmptyCodecIdentity {} -> MappedInvalidIdentity+        EmptyCodecVersion {} -> MappedInvalidIdentity+  TGAmbiguousName name origins ->+    [ mkErr (mappedLine spec name) MappedAmbiguousName $+        "type name '" <> name <> "' is ambiguous across " <> T.intercalate ", " origins+    ]+  TGUnresolvedRef owner missing loc ->+    [ mkErr (locLine loc) MappedUnresolvedName $+        "mapped declaration '" <> owner <> "' references unresolved mapped type '" <> missing <> "'"+    ]+  TGUnresolvedConsumerRef owner missing loc ->+    [ mkErr (locLine loc) MappedUnresolvedName $+        owner <> " references unresolved mapped type '" <> missing <> "'"+    ]+  TGRecursive names ->+    [ mkErr (mappedLine spec (headOr "<mapped>" names)) MappedRecursiveType $+        "recursive structural mapping is unsupported: " <> T.intercalate " -> " (names <> take 1 names)+    ]++declarationErrorMessage :: MappedDeclError -> Text+declarationErrorMessage = \case+  MissingHaskellSource _ -> "missing complete haskell package/module/type ingredient"+  MissingStructuralBinding _ -> "missing binding ingredient; GHC will verify the named value and its type"+  MissingStructuralBindingVersion _ -> "missing binding-version ingredient"+  MissingCanonicalType _ -> "missing canonical-type ingredient"+  MissingFixtureCases _ -> "missing fixtures ingredient; GHC will verify the named FixtureCases value"+  MissingOpaqueCodecIdentity _ -> "missing opaque codec identity ingredient"+  MissingOpaqueCodecVersion _ -> "missing opaque codec version ingredient"+  EmptyQualifiedValueName _ -> "a binding, fixture, or initial symbol is empty; GHC will verify a syntactically valid qualified value"+  EmptyCanonicalTypeId _ -> "canonical-type must be non-empty"+  EmptyBindingVersion _ -> "binding-version must be non-empty"+  EmptyCodecIdentity _ -> "opaque codec identity must be non-empty"+  EmptyCodecVersion _ -> "opaque codec version must be non-empty"++mappedLine :: Spec -> Name -> Int+mappedLine spec name =+  maybe 1 (locLine . mappedLoc) (firstMatching ((== name) . mappedName) ((.mapped) spec))++mappedName :: MappedDecl -> Name+mappedName MappedStructural {msName = name} = name+mappedName MappedOpaque {moName = name} = name++mappedLoc :: MappedDecl -> Loc+mappedLoc MappedStructural {msLoc = loc} = loc+mappedLoc MappedOpaque {moLoc = loc} = loc++mappedHaskell :: MappedDecl -> Maybe HaskellSource+mappedHaskell MappedStructural {msHaskell = source} = source+mappedHaskell MappedOpaque {moHaskell = source} = source++mappedCanonical :: MappedDecl -> Maybe Text+mappedCanonical MappedStructural {msCanonical = canonical} = canonical+mappedCanonical MappedOpaque {} = Nothing++mappedLexicalRules :: Spec -> [Diagnostic]+mappedLexicalRules spec = concatMap declarationRules ((.mapped) spec)+  where+    declarationRules declaration =+      constructorRule "mapped declaration name" (mappedName declaration) declaration+        ++ maybe [] (haskellRules declaration) (mappedHaskell declaration)+        ++ qualifiedFacts declaration+        ++ shapeConstructorRules declaration++    haskellRules declaration source =+      [ invalid declaration $ "Haskell package '" <> (.package) source <> "' does not follow Cabal package-name grammar"+      | not (isCabalPackageName ((.package) source))+      ]+        ++ [ invalid declaration $ "Haskell module '" <> (.moduleName) source <> "' must be dot-separated Upper identifiers"+           | not (moduleNameSafe ((.moduleName) source))+           ]+        ++ [ invalid declaration $ "Haskell type '" <> (.valueType) source <> "' must be an Upper identifier"+           | not (constructorSafe ((.valueType) source))+           ]++    qualifiedFacts MappedStructural {msBinding = binding, msFixtures = fixtures, msInitial = initial, msLoc = loc} =+      concatMap (qualifiedRule loc) [("binding", binding), ("fixtures", fixtures), ("initial", initial)]+    qualifiedFacts MappedOpaque {moFixtures = fixtures, moInitial = initial, moLoc = loc} =+      concatMap (qualifiedRule loc) [("fixtures", fixtures), ("initial", initial)]++    qualifiedRule loc (category, value) = case value of+      Just symbol+        | not (T.null symbol) && not (qualifiedValueSafe symbol) ->+            [ mkErr (locLine loc) MappedInvalidHaskellName $+                category <> " symbol '" <> symbol <> "' must be a module path plus a lower-initial value; GHC will verify that it exists with the promised type"+            ]+      _ -> []++    shapeConstructorRules declaration = case declaration of+      MappedStructural {msShape = ShapeRecord constructor _ fields} ->+        constructorRule "record constructor" constructor declaration+          ++ [ invalidAt (wireFieldLoc field) $ "record selector '" <> (.haskell) field <> "' must be a lower-initial Haskell identifier"+             | field <- fields,+               not (lowerIdentifierSafe ((.haskell) field))+             ]+      MappedStructural {msShape = ShapeEnum entries} ->+        [ invalidAt ((.loc) entry) $ "enum constructor '" <> (.ctor) entry <> "' must be an Upper identifier"+        | entry <- entries,+          not (constructorSafe ((.ctor) entry))+        ]+      MappedStructural {msShape = ShapeUnion _ arms} ->+        [ invalidAt ((.loc) arm) $ "union constructor '" <> (.ctor) arm <> "' must be an Upper identifier"+        | arm <- arms,+          not (constructorSafe ((.ctor) arm))+        ]+      MappedOpaque {} -> []++    constructorRule category value declaration =+      [ invalid declaration $ category <> " '" <> value <> "' must be an Upper identifier"+      | not (constructorSafe value)+      ]+    invalid declaration detail = invalidAt (mappedLoc declaration) detail+    invalidAt loc detail =+      mkErr (locLine loc) MappedInvalidHaskellName (detail <> "; this is a syntax check only, and GHC will verify the consumer declaration")++mappedIdentityRules :: Spec -> [Diagnostic]+mappedIdentityRules spec =+  [ mkErr (locLine (mappedLoc declaration)) MappedInvalidIdentity $+      "mapped declaration '" <> mappedName declaration <> "' has an identity/version containing an ASCII control character"+  | declaration <- (.mapped) spec,+    value <- identityValues declaration,+    T.any asciiControl value+  ]+  where+    identityValues MappedStructural {msBindingVersion = bindingVersion, msCanonical = canonical} = present [bindingVersion, canonical]+    identityValues MappedOpaque {moCodecId = codecIdentity, moCodecVersion = codecVersion} = present [codecIdentity, codecVersion]+    present = foldr (maybe id (:)) []++mappedConflictRules :: Spec -> [Diagnostic]+mappedConflictRules spec = sourceCollisions ++ canonicalCollisions ++ packageCollisions+  where+    declarations = (.mapped) spec+    sourceFacts = [(declaration, source) | declaration <- declarations, source <- maybeToList (mappedHaskell declaration)]+    sourceCollisions =+      [ conflict declaration $+          "Haskell target '" <> (.moduleName) source <> "." <> (.valueType) source <> "' is claimed by more than one mapped declaration"+      | (declaration, source) <- duplicatesBy (\(_, value) -> ((.moduleName) value, (.valueType) value)) sourceFacts+      ]+    canonicalFacts = [(declaration, canonical) | declaration <- declarations, canonical <- maybeToList (mappedCanonical declaration), not (T.null canonical)]+    canonicalCollisions =+      [ conflict declaration $ "canonical-type '" <> canonical <> "' is claimed by more than one mapped declaration"+      | (declaration, canonical) <- duplicatesBy snd canonicalFacts+      ]+    moduleFacts = [(declaration, (.moduleName) source, (.package) source) | (declaration, source) <- sourceFacts]+    packageCollisions =+      [ conflict declaration $+          "Haskell module '" <> moduleName <> "' is declared from conflicting packages '" <> oldPackage <> "' and '" <> packageName <> "'"+      | (index, (declaration, moduleName, packageName)) <- zip [0 :: Int ..] moduleFacts,+        (_, oldModule, oldPackage) <- take index moduleFacts,+        oldModule == moduleName,+        oldPackage /= packageName+      ]+    conflict declaration detail = mkErr (locLine (mappedLoc declaration)) MappedImportConflict detail+    maybeToList = maybe [] pure++mappedGraphRules :: Spec -> TypeGraph -> [Diagnostic]+mappedGraphRules spec graph =+  concatMap declarationRules (Map.elems ((.declarations) graph))+    ++ mappedRegisterInitialRules spec graph+  where+    declarationRules =+      foldMappedDecl+        MappedDeclAlgebra+          { onStructuralDecl = \declaration shape ->+              foldMappedShape (shapeRules declaration) shape,+            onOpaqueDecl = const []+          }++    shapeRules declaration =+      MappedShapeAlgebra+        { onRecord = \_ _ fields ->+            [ mappedError ((.loc) field) MappedDuplicateFieldName declaration $+                "record selector '" <> (.haskell) field <> "' is declared more than once"+            | field <- duplicatesBy (.haskell) fields+            ]+              ++ [ mappedError ((.loc) field) MappedDuplicateWireKey declaration $+                     "record wire key '" <> (.key) field <> "' is declared more than once"+                 | field <- duplicatesBy (.key) fields+                 ]+              ++ [ mappedError ((.loc) field) MappedUnsupportedEncoding declaration "record wire keys must be non-empty"+                 | field <- fields,+                   T.null ((.key) field)+                 ]+              ++ concatMap (fieldRules declaration) fields,+          onEnum = \entries ->+            [ mappedError ((.loc) entry) MappedDuplicateArmName declaration $+                "enum constructor '" <> (.ctor) entry <> "' is declared more than once"+            | entry <- duplicatesBy (.ctor) entries+            ]+              ++ [ mappedError ((.loc) entry) MappedDuplicateWireTag declaration $+                     "enum wire spelling '" <> (.tag) entry <> "' is declared more than once"+                 | entry <- duplicatesBy (.tag) entries+                 ]+              ++ [ mappedError ((.loc) entry) MappedUnsupportedEncoding declaration "enum wire spellings must be non-empty"+                 | entry <- entries,+                   T.null ((.tag) entry)+                 ],+          onUnion = \encoding arms ->+            [ mappedError ((.loc) declaration) MappedUnsupportedEncoding declaration "tagged-object tag and contents keys must be distinct"+            | (.tagField) encoding == (.contentsField) encoding+            ]+              ++ [ mappedError ((.loc) declaration) MappedUnsupportedEncoding declaration "tagged-object tag and contents keys must be non-empty"+                 | T.null ((.tagField) encoding) || T.null ((.contentsField) encoding)+                 ]+              ++ [ mappedError ((.loc) arm) MappedDuplicateArmName declaration $+                     "union constructor '" <> (.ctor) arm <> "' is declared more than once"+                 | arm <- duplicatesBy (.ctor) arms+                 ]+              ++ [ mappedError ((.loc) arm) MappedDuplicateWireTag declaration $+                     "union wire tag '" <> (.tag) arm <> "' is declared more than once"+                 | arm <- duplicatesBy (.tag) arms+                 ]+              ++ [ mappedError ((.loc) arm) MappedUnsupportedEncoding declaration "union wire tags must be non-empty"+                 | arm <- arms,+                   T.null ((.tag) arm)+                 ]+              ++ concatMap (armRules declaration) arms+        }++    fieldRules declaration field =+      defaultRules declaration field+        ++ [ mappedError ((.loc) field) MappedNonInjectiveNullability declaration $+               "field '" <> (.haskell) field <> "' contains Optional around a null-capable Json, Optional, or opaque mapped value"+           | hasNonInjectiveOptional graph ((.valueType) field)+           ]++    armRules declaration arm =+      [ mappedError ((.loc) arm) MappedNonInjectiveNullability declaration $+          "union arm '" <> (.ctor) arm <> "' contains Optional around a null-capable Json, Optional, or opaque mapped value"+      | payload <- maybeToList ((.payload) arm),+        hasNonInjectiveOptional graph payload+      ]++    defaultRules declaration field = case ((.presence) field, (.onMissing) field) of+      (PRequired, Just _) -> [illTyped "required fields cannot declare on-missing"]+      (POptional, Nothing) ->+        [ mappedError ((.loc) field) MappedMissingIngredient declaration $+            "optional field '" <> (.haskell) field <> "' is missing its on-missing policy"+        ]+      (POptional, Just value)+        | not (defaultMatches graph ((.valueType) field) value) -> [illTyped "on-missing value does not match the field type or numeric bounds"]+      _ -> []+      where+        illTyped detail =+          mappedError ((.loc) field) MappedDefaultIllTyped declaration $+            "field '" <> (.haskell) field <> "': " <> detail++    mappedError loc diagnosticCode declaration detail =+      mkErr (locLine loc) diagnosticCode $+        "mapped declaration '" <> (.name) declaration <> "' " <> detail+    maybeToList = maybe [] pure++data DefaultType+  = DefaultText+  | DefaultInt+  | DefaultBool+  | DefaultNatural+  | DefaultOptional+  | DefaultList+  | DefaultMap+  | DefaultEnum !(Set Name)+  | DefaultOther++defaultMatches :: TypeGraph -> ResolvedTypeExpr -> OnMissing -> Bool+defaultMatches graph expression value = case (defaultType graph expression, value) of+  (DefaultText, OmText _) -> True+  (DefaultInt, OmInt integer) -> integer >= toInteger (minBound :: Int) && integer <= toInteger (maxBound :: Int)+  (DefaultBool, OmBool _) -> True+  (DefaultNatural, OmInt integer) -> integer >= 0+  (DefaultOptional, OmNull) -> True+  (DefaultList, OmEmptyList) -> True+  (DefaultMap, OmEmptyMap) -> True+  (DefaultEnum constructors, OmCtor constructor) -> constructor `Set.member` constructors+  _ -> False++defaultType :: TypeGraph -> ResolvedTypeExpr -> DefaultType+defaultType graph =+  foldTypeExpr+    TypeExprAlgebra+      { onText = DefaultText,+        onInt = DefaultInt,+        onInteger = DefaultInt,+        onBool = DefaultBool,+        onNatural = DefaultNatural,+        onTime = DefaultOther,+        onJson = DefaultOther,+        onOptional = const DefaultOptional,+        onList = const DefaultList,+        onMap = const DefaultMap,+        onRef = referencedDefaultType graph+      }++referencedDefaultType :: TypeGraph -> MappedKey -> DefaultType+referencedDefaultType graph key = case Map.lookup key ((.declarations) graph) of+  Nothing -> DefaultOther+  Just declaration ->+    foldMappedDecl+      MappedDeclAlgebra+        { onStructuralDecl = \_ shape ->+            foldMappedShape+              MappedShapeAlgebra+                { onRecord = \_ _ _ -> DefaultOther,+                  onEnum = DefaultEnum . Set.fromList . map (.ctor),+                  onUnion = \_ _ -> DefaultOther+                }+              shape,+          onOpaqueDecl = const DefaultOther+        }+      declaration++data NullabilityFacts = NullabilityFacts+  { topNull :: !Bool,+    badOptional :: !Bool+  }++hasNonInjectiveOptional :: TypeGraph -> ResolvedTypeExpr -> Bool+hasNonInjectiveOptional graph =+  (.badOptional)+    . foldTypeExpr+      TypeExprAlgebra+        { onText = nonNull,+          onInt = nonNull,+          onInteger = nonNull,+          onBool = nonNull,+          onNatural = nonNull,+          onTime = nonNull,+          onJson = nullable,+          onOptional = \child -> NullabilityFacts True ((.topNull) child || (.badOptional) child),+          onList = nestedNonNull,+          onMap = nestedNonNull,+          onRef = \key -> if mappedRefIsOpaque graph key then nullable else nonNull+        }+  where+    nonNull = NullabilityFacts False False+    nullable = NullabilityFacts True False+    nestedNonNull child = NullabilityFacts False ((.badOptional) child)++mappedRefIsOpaque :: TypeGraph -> MappedKey -> Bool+mappedRefIsOpaque graph key = case Map.lookup key ((.declarations) graph) of+  Nothing -> False+  Just declaration ->+    foldMappedDecl+      MappedDeclAlgebra+        { onStructuralDecl = \_ _ -> False,+          onOpaqueDecl = const True+        }+      declaration++mappedRegisterInitialRules :: Spec -> TypeGraph -> [Diagnostic]+mappedRegisterInitialRules spec graph =+  concatMap aggregateRules [aggregate | NAggregate aggregate <- (.nodes) spec]+  where+    aggregateRules aggregate = concatMap registerRule ((.regs) aggregate)+    registerRule register = case (.valueType) register of+      TRef typeName -> case Map.lookup (MappedKey typeName) ((.declarations) graph) of+        Nothing -> []+        Just declaration -> case (.initial) register of+          RegInitBare "initial"+            | mappedInitial declaration == Nothing ->+                [ mkErr (locLine ((.loc) register)) MappedMissingInitialValue $+                    "mapped register '" <> (.name) register <> "' requires declaration '" <> typeName <> "' to name an explicit initial value"+                ]+            | otherwise -> []+          _ ->+            [ mkErr (locLine ((.loc) register)) RegisterInitialOutOfScope $+                "mapped register '" <> (.name) register <> "' must use the bare initial token; the declaration-owned symbol is verified by GHC"+            ]+      _ -> []+    mappedInitial =+      foldMappedDecl+        MappedDeclAlgebra+          { onStructuralDecl = \declaration _ -> (.initial) declaration,+            onOpaqueDecl = (.initial)+          }++moduleNameSafe :: Text -> Bool+moduleNameSafe moduleName =+  not (null components) && all constructorSafe components+  where+    components = T.splitOn "." moduleName++qualifiedValueSafe :: Text -> Bool+qualifiedValueSafe qualified = case reverse (T.splitOn "." qualified) of+  value : reversedModule ->+    not (null reversedModule)+      && lowerIdentifierSafe value+      && all constructorSafe reversedModule+  [] -> False++lowerIdentifierSafe :: Text -> Bool+lowerIdentifierSafe name = case T.uncons name of+  Just (first, rest) -> asciiLower first && T.all asciiAlphaNumOrUnderscore rest && name `Set.notMember` HaskellName.haskellKeywords+  Nothing -> False++asciiControl :: Char -> Bool+asciiControl c = ord c < 32 || ord c == 127++firstMatching :: (a -> Bool) -> [a] -> Maybe a+firstMatching predicate = \case+  [] -> Nothing+  value : rest+    | predicate value -> Just value+    | otherwise -> firstMatching predicate rest++headOr :: a -> [a] -> a+headOr fallback = \case+  [] -> fallback+  value : _ -> value++-- | Check every logical name before a renderer can turn it into Haskell.  The+-- parser enforces the ASCII alphabet; 'HaskellName' owns word segmentation,+-- casing, keywords, and normalized collision keys.+validateNames :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> [Diagnostic]+validateNames languageContract typeGraphResult spec =+  concat+    [ concatMap idNames ((.ids) spec),+      concatMap enumNames ((.enums) spec),+      concatMap nominalNames ((.nominalScalars) spec),+      concatMap nodeNames ((.nodes) spec),+      normalizedCollisions+    ]+  where+    idNames declaration =+      constructorName "id name" ((.name) declaration) ((.loc) declaration)++    enumNames declaration =+      constructorName "enum name" ((.name) declaration) ((.loc) declaration)+        ++ concatMap+          (\(ctor, _) -> constructorName ("constructor of enum '" <> (.name) declaration <> "'") ctor ((.loc) declaration))+          ((.ctors) declaration)++    nominalNames declaration =+      constructorName "nominal scalar name" ((.name) declaration) ((.loc) declaration)++    nodeNames = \case+      NAggregate aggregate -> aggregateNames aggregate+      NProcess process -> processNames process+      NRouter router -> routerNames router+      NContract contract ->+        pascalizedNodeName "contract" ((.name) contract) ((.loc) contract)+          ++ concatMap+            (\event -> constructorName "contract event name" ((.name) event) ((.loc) contract) ++ concatMap contractFieldName ((.fields) event))+            ((.events) contract)+      NIntake intake -> pascalizedNodeName "intake" ((.name) intake) ((.loc) intake)+      NEmit emitNode -> pascalizedNodeName "emit" ((.name) emitNode) ((.loc) emitNode)+      NPublisher publisher -> pascalizedNodeName "publisher" ((.name) publisher) ((.loc) publisher)+      NWorkqueue workqueue ->+        pascalizedNodeName "workqueue" ((.name) workqueue) ((.loc) workqueue)+          ++ constructorName "workqueue payload name" ((.payloadName) workqueue) ((.loc) workqueue)+          ++ concatMap (\field -> fieldNameRule "workqueue payload field" ((.name) field) ((.loc) workqueue)) ((.payload) workqueue)+      NPgmqDispatch dispatch -> pascalizedNodeName "dispatch" ((.name) dispatch) ((.loc) dispatch)+      NReadModel readModel -> pascalizedNodeName "readmodel" ((.name) readModel) ((.loc) readModel)+      NProjectionTarget target -> pascalizedNodeName "target" ((.name) target) ((.loc) target)+      NRebuildGroup groupNode -> pascalizedNodeName "rebuild group" ((.name) groupNode) ((.loc) groupNode)+      NProjectionRevision revision -> pascalizedNodeName "projection revision" ((.name) revision) ((.loc) revision)+      NExternalRead externalRead -> pascalizedNodeName "external read" (externalReadNodeIdentity externalRead) ((.loc) externalRead)+      NProjectionOwner owner -> pascalizedNodeName "projection owner" ((.name) owner) ((.loc) owner)+      NWorkflow workflow -> workflowNames workflow+      NOperation _ -> []++    aggregateNames aggregate =+      constructorName "aggregate name" ((.name) aggregate) ((.loc) aggregate)+        ++ concatMap+          (\register -> fieldNameRule "register name" ((.name) register) ((.loc) register))+          ((.regs) aggregate)+        ++ concatMap commandNames ((.commands) aggregate)+        ++ concatMap eventNames ((.events) aggregate)+        ++ maybe [] (\projection -> fieldNameRule "projection key" ((.key) projection) ((.loc) projection)) ((.projection) aggregate)+        ++ vertexCollisions aggregate+      where+        commandNames command =+          constructorName "command name" ((.name) command) ((.loc) command)+            ++ concatMap (aggregateFieldNameRule "command field") ((.fields) command)+        eventNames event =+          constructorName "event name" ((.name) event) ((.loc) event)+            ++ case (.body) event of+              EventFields fields -> concatMap (aggregateFieldNameRule "event field") fields+              EventFromCommand _ -> []++    processNames process =+      constructorName "process name" ((.id) process) ((.loc) process)+        ++ constructorName "process input name" ((.name) input) ((.loc) process)+        ++ concatMap (\field -> fieldNameRule "process input field" ((.name) field) ((.loc) process)) ((.fields) input)+        ++ concatMap (bindingName "advance field binding" ((.loc) process)) ((.advFields) ((.advance) handle))+        ++ concatMap dispatchBindings ((.dispatch) handle)+        ++ concatMap (bindingName "timer payload field binding" ((.loc) timer)) ((.payload) timer)+        ++ concatMap (bindingName "timer fire field binding" ((.loc) timer)) ((.fields) ((.fire) timer))+      where+        input = (.input) process+        handle = (.handle) process+        timer = (.timer) process+        dispatchBindings dispatch = concatMap (bindingName "dispatch field binding" ((.loc) dispatch)) ((.fields) dispatch)++    routerNames router =+      constructorName "router name" ((.id) router) ((.loc) router)+        ++ constructorName "router input name" ((.name) input) ((.loc) router)+        ++ concatMap (\field -> fieldNameRule "router input field" ((.name) field) ((.loc) router)) ((.fields) input)+        ++ concatMap (\field -> fieldNameRule "router resolve-row field" field ((.loc) resolve)) ((.row) resolve)+        ++ concatMap (bindingName "router dispatch field binding" ((.loc) dispatch)) ((.fields) dispatch)+      where+        input = (.input) router+        resolve = (.resolve) router+        dispatch = (.dispatch) router++    bindingName category anchor binding = fieldNameRule category ((.name) binding) anchor+    contractFieldName = contractFieldNameRule "contract field"++    aggregateFieldNameRule category field =+      case (.selector) field of+        Nothing -> fieldNameRule category ((.name) field) ((.loc) field)+        Just selector -> explicitFieldSelectorRule category ((.name) field) selector ((.loc) field)++    contractFieldNameRule category field =+      case (.selector) field of+        Nothing -> fieldNameRule category ((.name) field) ((.loc) field)+        Just selector -> explicitFieldSelectorRule category ((.name) field) selector ((.loc) field)++    explicitFieldSelectorRule category dslName selector anchor =+      case HaskellName.checkedLowerOccurrence site selector of+        Right _ -> []+        Left nameError -> [nameErrorDiagnostic (category <> " selector") nameError]+      where+        site =+          HaskellName.NameSite+            { HaskellName.kind = HaskellName.GeneratedFieldSite,+              HaskellName.logicalName = selector,+              HaskellName.owner = category <> ":" <> dslName,+              HaskellName.line = locLine anchor+            }++    constructorName category name anchor = checkedLogicalName HaskellName.GeneratedTypeSite category name anchor++    workflowNames workflow =+      constructorName "workflow name" ((.id) workflow) (workflowNodeLoc workflow)+        <> concat+          [ case HaskellName.deriveLowerHelperName HaskellName.LogicalWireWord "Await" site of+              Right _ -> []+              Left nameError -> [nameErrorDiagnostic "workflow await binding" nameError]+          | (label, loc) <- workflowAwaits ((.body) workflow),+            let site = workflowAwaitBindingSite workflow label loc+          ]++    pascalizedNodeName category name anchor = checkedLogicalName HaskellName.NodeModuleSite (category <> " name") name anchor++    fieldNameRule category name anchor = checkedLogicalName HaskellName.GeneratedFieldSite category name anchor++    checkedLogicalName kind category name anchor =+      case deriveAt HaskellName.LogicalIdentifier kind category name anchor of+        Right _ -> []+        Left nameError -> [nameErrorDiagnostic category nameError]++    deriveAt source kind category name anchor =+      HaskellName.deriveHaskellName source (nameSite kind category name anchor)++    nameSite kind category name anchor =+      HaskellName.NameSite+        { HaskellName.kind = kind,+          HaskellName.logicalName = name,+          HaskellName.owner = category <> ":" <> name,+          HaskellName.line = locLine anchor+        }++    nameErrorDiagnostic category = \case+      HaskellName.EmptyNameSegment site ->+        mkErr ((.line) site) IdentUnsafeNormalization $+          category <> " '" <> (.logicalName) site <> "' has an empty generated-Haskell word"+      HaskellName.UnsafeNameSeparator site reason ->+        mkErr ((.line) site) IdentUnsafeNormalization $+          category <> " '" <> (.logicalName) site <> "' cannot be normalized safely: " <> reason+      HaskellName.ReservedGeneratedOccurrence site occurrence ->+        mkErr ((.line) site) GeneratedOccurrenceReserved $+          category <> " '" <> (.logicalName) site <> "' normalizes to reserved Haskell occurrence '" <> occurrence <> "'"+      HaskellName.InvalidExplicitHaskellName site occurrence ->+        mkErr ((.line) site) IdentUnsafeNormalization $+          category <> " '" <> (.logicalName) site <> "' cannot become generated Haskell occurrence '" <> occurrence <> "'"+      collision@HaskellName.NormalizedNameCollision {} -> collisionDiagnostic collision++    normalizedCollisions = map collisionDiagnostic (HaskellName.detectNameCollisions collisionOccurrences)++    collisionOccurrences =+      nodeModuleOccurrences+        <> sharedTypeOccurrences+        <> concatMap aggregateFieldOccurrences aggregates+        <> concatMap aggregateHarnessOccurrences aggregates+        <> concatMap contractFieldOccurrences contracts+        <> concatMap workflowRuntimeOccurrences workflows++    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    contracts = [contract | NContract contract <- (.nodes) spec]+    workflows = [workflow | NWorkflow workflow <- (.nodes) spec]++    contextSegment =+      case deriveAt HaskellName.LogicalWireWord HaskellName.ContextModuleSite "context" ((.context) spec) (Loc 1) of+        Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)+        Left _ -> (.context) spec++    nodeModuleOccurrences =+      [ HaskellName.plannedOccurrence contextSegment HaskellName.ModuleSpace "" rendered site+      | node <- (.nodes) spec,+        let (category, raw, anchor) = nodeNameAndLoc node,+        let site = nameSite HaskellName.NodeModuleSite category raw anchor,+        Right derived <- [HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site],+        let rendered = HaskellName.renderUpperCamelName ((.upperCamel) derived)+      ]++    sharedTypeOccurrences =+      [ HaskellName.plannedOccurrence ("Generated." <> contextSegment <> ".Nominals") HaskellName.TypeSpace "" rendered site+      | (category, raw, anchor) <-+          [("id", (.name) declaration, (.loc) declaration) | declaration <- (.ids) spec]+            <> [("enum", (.name) declaration, (.loc) declaration) | declaration <- (.enums) spec]+            <> [("nominal", (.name) declaration, (.loc) declaration) | declaration <- (.nominalScalars) spec],+        let site = nameSite HaskellName.GeneratedTypeSite category raw anchor,+        Right derived <- [HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site],+        let rendered = HaskellName.renderUpperCamelName ((.upperCamel) derived)+      ]++    aggregateFieldOccurrences aggregate = commandFields <> eventFields+      where+        targetModule = "Generated." <> contextSegment <> "." <> normalizedUpper "aggregate" ((.name) aggregate) ((.loc) aggregate) <> ".Domain"+        commandFields =+          [ fieldOccurrence targetModule ((.name) command) "command field" field+          | command <- (.commands) aggregate,+            field <- (.fields) command+          ]+        eventFields =+          [ fieldOccurrence targetModule ((.name) event) "event field" field+          | event <- (.events) aggregate,+            field <- eventFieldsFor aggregate event+          ]++    eventFieldsFor aggregate event =+      case (.body) event of+        EventFields fields -> fields+        EventFromCommand commandName ->+          [ field+          | command <- (.commands) aggregate,+            (.name) command == commandName,+            field <- (.fields) command+          ]++    -- The occurrence registered here must be the selector generation actually+    -- emits — 'resolveAggregateFieldIdentity', which falls back to the raw DSL+    -- name, not a camelized rendering of it. Registering the camelized form made+    -- the planner claim `foo_bar` "normalizes to" `fooBar`, which generation+    -- never does, and let two fields that generate distinct selectors be+    -- reported as colliding. A field whose raw name is not lowerCamelCase is+    -- still refused, by the generated-name audit that owns that rule and says so.+    fieldOccurrence targetModule scope category field =+      let identity = resolveAggregateFieldIdentity field+          site = nameSite HaskellName.GeneratedFieldSite category ((.dslName) identity) ((.loc) field)+       in HaskellName.plannedOccurrence targetModule HaskellName.FieldSpace scope ((.selector) identity) site++    aggregateHarnessOccurrences aggregate =+      transitionHelpers <> sampleConstants+      where+        transitionHelpers =+          concat+            [ [helperOccurrence "accept" ("accept" <> commandName) transition]+                <> [helperOccurrence "forward/replay" ("forwardReplay" <> commandName) transition | not (null ((.emits) transition))]+            | transition <- (.transitions) aggregate,+              (.source) transition == initialState,+              (.mode) transition == TmLive,+              let commandName = (.command) transition+            ]+        sampleConstants = map idSampleOccurrence generatedIds <> maybe [] (pure . timeSampleOccurrence) timeSample+        resolvedHarnessFields =+          [ (field, resolvedType)+          | (useSite, field) <- harnessFields aggregate,+            Right resolvedType <- [inferAggregateFieldType symbols aggregate useSite field]+          ]+        generatedIds =+          Map.elems . Map.fromList $+            [ ((.name) nominal, nominal)+            | (_, AggregateNominal nominal) <- resolvedHarnessFields,+              Nominal.GeneratedNominal <- [(.ownership) nominal],+              Nominal.IdRepresentation prefix <- [(.representation) nominal],+              idDomainContractFor languageContract prefix /= Nothing+            ]+        timeFields = [field | (field, AggregateTime) <- resolvedHarnessFields]+        timeSample = case filter ((== "observedAt") . (.name)) timeFields of+          field : _ -> Just ("sampleObservedAt", field)+          [] -> case timeFields of+            field : _ -> Just ("sampleTime", field)+            [] -> Nothing+        initialState = case (.states) aggregate of+          state : _ -> (.name) state+          [] -> ""+        symbols = aggregateSymbolsFromGraphResult typeGraphResult spec+        targetModule =+          "Generated."+            <> contextSegment+            <> "."+            <> normalizedUpper "aggregate" ((.name) aggregate) ((.loc) aggregate)+            <> ".Harness"+        helperOccurrence helperKind rendered transition =+          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site+          where+            site =+              HaskellName.NameSite+                { HaskellName.kind = HaskellName.GeneratedHelperSite,+                  HaskellName.logicalName = (.command) transition,+                  HaskellName.owner = "aggregate:" <> (.name) aggregate <> ":" <> helperKind <> ":line:" <> T.pack (show (locLine ((.loc) transition))),+                  HaskellName.line = locLine ((.loc) transition)+                }+        idSampleOccurrence nominal =+          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" ("sample" <> nominalName) site+          where+            nominalName = (.name) nominal+            loc = (.loc) nominal+            site =+              HaskellName.NameSite+                { HaskellName.kind = HaskellName.GeneratedHelperSite,+                  HaskellName.logicalName = nominalName,+                  HaskellName.owner = "aggregate:" <> (.name) aggregate <> ":sample-id:" <> nominalName,+                  HaskellName.line = locLine loc+                }+        timeSampleOccurrence (rendered, field) =+          HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site+          where+            site =+              HaskellName.NameSite+                { HaskellName.kind = HaskellName.GeneratedHelperSite,+                  HaskellName.logicalName = (.name) field,+                  HaskellName.owner = "aggregate:" <> (.name) aggregate <> ":sample-time",+                  HaskellName.line = locLine ((.loc) field)+                }++    workflowRuntimeOccurrences workflow =+      [ HaskellName.plannedOccurrence targetModule HaskellName.ValueSpace "" rendered site+      | (label, loc) <- workflowAwaits ((.body) workflow),+        let site = workflowAwaitBindingSite workflow label loc,+        Right awaitName <- [HaskellName.deriveLowerHelperName HaskellName.LogicalWireWord "Await" site],+        let rendered = HaskellName.renderLowerCamelName awaitName+      ]+      where+        targetModule =+          "Generated."+            <> contextSegment+            <> "."+            <> normalizedUpper "workflow" ((.id) workflow) (workflowNodeLoc workflow)+            <> ".WorkflowRuntime"++    workflowAwaitBindingSite workflow label loc =+      HaskellName.NameSite+        { HaskellName.kind = HaskellName.GeneratedValueSite,+          HaskellName.logicalName = label,+          HaskellName.owner = "workflow:" <> (.id) workflow <> ":await:" <> label,+          HaskellName.line = locLine loc+        }++    workflowAwaits = concatMap go+      where+        go (WfAwait label _ loc) = [(label, loc)]+        go (WfPatch _ items _) = workflowAwaits items+        go _ = []++    harnessFields aggregate =+      [(CommandFieldUse, field) | command <- (.commands) aggregate, field <- (.fields) command]+        <> [ (EventFieldUse, field)+           | event <- (.events) aggregate,+             field <- eventFieldsFor aggregate event+           ]++    contractFieldOccurrences contract =+      [ contractFieldOccurrence targetModule ((.name) event <> "Data") field+      | event <- (.events) contract,+        field <- (.fields) event+      ]+      where+        targetModule =+          "Generated."+            <> contextSegment+            <> "."+            <> normalizedUpper "contract" ((.name) contract) ((.loc) contract)+            <> ".Contract"++    contractFieldOccurrence targetModule scope field =+      let identity = resolveContractFieldIdentity field+          site = nameSite HaskellName.GeneratedFieldSite "contract field" ((.dslName) identity) ((.loc) identity)+          rendered = case (.selector) field of+            Just selector -> selector+            Nothing -> case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of+              Right derived -> HaskellName.renderLowerCamelName ((.lowerCamel) derived)+              Left _ -> (.selector) identity+       in HaskellName.plannedOccurrence targetModule HaskellName.FieldSpace scope rendered site++    normalizedUpper category raw anchor =+      case deriveAt HaskellName.LogicalIdentifier HaskellName.GeneratedTypeSite category raw anchor of+        Right derived -> HaskellName.renderUpperCamelName ((.upperCamel) derived)+        Left _ -> raw++    nodeNameAndLoc = \case+      NAggregate value -> ("aggregate", (.name) value, (.loc) value)+      NProcess value -> ("process", (.id) value, (.loc) value)+      NRouter value -> ("router", (.id) value, (.loc) value)+      NContract value -> ("contract", (.name) value, (.loc) value)+      NIntake value -> ("intake", (.name) value, (.loc) value)+      NEmit value -> ("emit", (.name) value, (.loc) value)+      NPublisher value -> ("publisher", (.name) value, (.loc) value)+      NWorkqueue value -> ("workqueue", (.name) value, (.loc) value)+      NPgmqDispatch value -> ("dispatch", (.name) value, (.loc) value)+      NReadModel value -> ("readmodel", (.name) value, (.loc) value)+      NProjectionTarget value -> ("target", (.name) value, (.loc) value)+      NRebuildGroup value -> ("rebuild-group", (.name) value, (.loc) value)+      NProjectionRevision value -> ("projection-revision", (.name) value, (.loc) value)+      NExternalRead value -> ("external-read", externalReadNodeIdentity value, (.loc) value)+      NProjectionOwner value -> ("projection-owner", (.name) value, (.loc) value)+      NWorkflow value -> ("workflow", (.id) value, workflowNodeLoc value)+      NOperation value -> ("operation", (.name) value, (.loc) value)++    collisionDiagnostic (HaskellName.NormalizedNameCollision key sites) =+      case reverse (NE.toList sites) of+        primary : reversedEarlier ->+          Diagnostic+            { line = (.line) primary,+              severity = Error,+              code = GeneratedOccurrenceCollision,+              relatedLocations =+                [ ((.line) site, "'" <> (.logicalName) site <> "' also normalizes here")+                | site <- reverse reversedEarlier+                ],+              message =+                "logical declarations "+                  <> T.intercalate ", " ["'" <> (.logicalName) site <> "'" | site <- NE.toList sites]+                  <> " normalize to the same Haskell occurrence '"+                  <> (.name) key+                  <> "' in "+                  <> (.moduleName) key+                  <> " ("+                  <> T.pack (show ((.space) key))+                  <> ")"+            }+        [] -> mkErr 1 GeneratedOccurrenceCollision "internal error: normalized collision without source sites"+    collisionDiagnostic nameError = nameErrorDiagnostic "generated declaration" nameError++    vertexCollisions aggregate =+      [ mkErr (locLine ((.loc) aggregate)) VertexCtorCollision $+          "aggregate '"+            <> (.name) aggregate+            <> "' state '"+            <> (.name) state+            <> "' generates vertex constructor '"+            <> vertex+            <> "', which collides with "+            <> declarationKind+            <> " '"+            <> vertex+            <> "' in the generated Domain constructor namespace"+      | state <- (.states) aggregate,+        let vertex = normalizedUpper "aggregate" ((.name) aggregate) ((.loc) aggregate) <> normalizedUpper "state" ((.name) state) ((.loc) state),+        declarationKind <- collisionKinds aggregate vertex+      ]++    collisionKinds aggregate vertex =+      ["event" | vertex `elem` [normalizedUpper "event" ((.name) event) ((.loc) event) | event <- (.events) aggregate]]+        ++ ["command" | vertex `elem` [normalizedUpper "command" ((.name) command) ((.loc) command) | command <- (.commands) aggregate]]+        ++ ["enum constructor" | vertex `elem` [normalizedUpper "enum constructor" ctor ((.loc) enum) | enum <- (.enums) spec, (ctor, _) <- (.ctors) enum]]++-- Explicit consumer-owned Haskell references keep their spelling and use the+-- historical lexical check. Generated names never call this helper.+constructorSafe :: Name -> Bool+constructorSafe name = case T.uncons name of+  Just (first, rest) -> asciiUpper first && T.all asciiAlphaNumOrUnderscore rest+  Nothing -> False++asciiUpper :: Char -> Bool+asciiUpper c = c >= 'A' && c <= 'Z'++asciiLower :: Char -> Bool+asciiLower c = c >= 'a' && c <= 'z'++asciiAlphaNumOrUnderscore :: Char -> Bool+asciiAlphaNumOrUnderscore c = asciiUpper c || asciiLower c || (c >= '0' && c <= '9') || c == '_'++kafkaTopicError :: Text -> Maybe Text+kafkaTopicError topic+  | T.null topic = Just "is empty"+  | T.length topic > 249 = Just "is longer than Kafka's 249-character limit"+  | topic == "." || topic == ".." = Just "is reserved by Kafka"+  | Just illegal <- T.find (not . kafkaTopicCharacter) topic =+      Just ("contains character " <> T.pack (show illegal) <> "; use only ASCII letters, digits, '.', '_', or '-'")+  | otherwise = Nothing+  where+    kafkaTopicCharacter character = asciiAlphaNumOrUnderscore character || character == '.' || character == '-'++validPostgresIdentifier :: Text -> Bool+validPostgresIdentifier identifier =+  T.length identifier <= 63+    && case T.uncons identifier of+      Nothing -> False+      Just (firstCharacter, rest) ->+        (asciiLower firstCharacter || firstCharacter == '_')+          && T.all (\character -> asciiLower character || (character >= '0' && character <= '9') || character == '_') rest++-- | Rules over namespaces shared by the whole specification.+specLevelRules :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> [Diagnostic]+specLevelRules languageContract supplyAnalysis spec = duplicateNodes ++ duplicateEnumMembers ++ duplicateIdPrefixes ++ duplicateDeclarations ++ runtimeIdentities ++ duplicateRuntimeIdentities ++ catalogRules ++ ruleDiagnostics+  where+    duplicateNodes =+      [ mkErr (locLine loc) DuplicateNodeName $+          "duplicate " <> kind <> " node name '" <> name <> "'"+      | node <- duplicatesBy nodeKey ((.nodes) spec),+        let (kind, name, loc) = nodeIdentity node+      ]+    nodeKey node = let (kind, name, _) = nodeIdentity node in (kind, name)+    duplicateEnumMembers = concatMap enumDuplicates ((.enums) spec)+    enumDuplicates e =+      [ mkErr (locLine ((.loc) e)) DuplicateEnumCtor $+          "enum '" <> (.name) e <> "' declares constructor '" <> ctor <> "' more than once"+      | (ctor, _) <- duplicatesBy fst ((.ctors) e)+      ]+        ++ [ mkErr (locLine ((.loc) e)) DuplicateEnumWire $+               "enum '" <> (.name) e <> "' declares wire spelling '" <> wire <> "' more than once"+           | (_, wire) <- duplicatesBy snd ((.ctors) e)+           ]+    duplicateIdPrefixes =+      [ mkErr (locLine ((.loc) d)) DuplicateIdPrefix $+          "id '" <> (.name) d <> "' reuses prefix '" <> (.prefix) d <> "'"+      | d <- duplicatesBy (.prefix) ((.ids) spec)+      ]+    duplicateDeclarations =+      [ mkErr (locLine loc) NominalDuplicateDeclaration $+          "duplicate " <> category <> " declaration '" <> name <> "'; the last declaration would silently replace the earlier one"+      | enforcesSpecSurfaceClosures languageContract,+        (category, name, loc) <- duplicatesBy (\(category, name, _) -> (category, name)) declarationOrigins+      ]+    declarationOrigins =+      [("id", (.name) value, (.loc) value) | value <- (.ids) spec]+        <> [("enum", (.name) value, (.loc) value) | value <- (.enums) spec]+        <> [("nominal scalar", (.name) value, (.loc) value) | value <- (.nominalScalars) spec]+        <> [("mapped", mappedName value, mappedLoc value) | value <- (.mapped) spec]+        <> [("rule", (.name) value, (.loc) value) | value <- (.rules) spec]+    runtimeIdentities =+      [ mkErr (locLine loc) RuntimeIdentityInvalid $+          kind <> " stable identity " <> T.pack (show identity) <> " " <> reason+      | enforcesSpecSurfaceClosures languageContract,+        (kind, identity, loc) <- stableIdentityOrigins,+        Just reason <- [stableIdentityError identity]+      ]+    duplicateRuntimeIdentities =+      [ mkErr (locLine loc) RuntimeIdentityDuplicate $+          kind <> " stable identity " <> T.pack (show identity) <> " is already used by another workflow, process, or router"+      | enforcesSpecSurfaceClosures languageContract,+        (kind, identity, loc) <- duplicatesBy (\(_, identity, _) -> identity) stableIdentityOrigins+      ]+    stableIdentityOrigins =+      [("workflow", (.stable) workflow, workflowNodeLoc workflow) | NWorkflow workflow <- (.nodes) spec]+        <> [("process", (.name) process, (.loc) process) | NProcess process <- (.nodes) spec]+        <> [("router", (.name) router, (.loc) router) | NRouter router <- (.nodes) spec]+    catalogRules+      | hasProjectionCatalog languageContract = validateProjectionCatalogFleet supplyAnalysis spec+      | otherwise = []+    ruleDiagnostics = concatMap (validateRule spec) ((.rules) spec)++nodeIdentity :: Node -> (Text, Name, Loc)+nodeIdentity (NAggregate a) = ("aggregate", (.name) a, (.loc) a)+nodeIdentity (NProcess p) = ("process", (.id) p, (.loc) p)+nodeIdentity (NRouter r) = ("router", (.id) r, (.loc) r)+nodeIdentity (NContract c) = ("contract", (.name) c, (.loc) c)+nodeIdentity (NIntake i) = ("intake", (.name) i, (.loc) i)+nodeIdentity (NEmit e) = ("emit", (.name) e, (.loc) e)+nodeIdentity (NPublisher p) = ("publisher", (.name) p, (.loc) p)+nodeIdentity (NWorkqueue w) = ("workqueue", (.name) w, (.loc) w)+nodeIdentity (NPgmqDispatch d) = ("dispatch", (.name) d, (.loc) d)+nodeIdentity (NReadModel r) = ("readmodel", (.name) r, (.loc) r)+nodeIdentity (NProjectionTarget target) = ("target", (.name) target, (.loc) target)+nodeIdentity (NRebuildGroup groupNode) = ("rebuild-group", (.name) groupNode, (.loc) groupNode)+nodeIdentity (NProjectionRevision revision) = ("projection-revision", (.name) revision, (.loc) revision)+nodeIdentity (NExternalRead externalRead) = ("external-read", externalReadNodeIdentity externalRead, (.loc) externalRead)+nodeIdentity (NProjectionOwner owner) = ("projection-owner", (.name) owner, (.loc) owner)+nodeIdentity (NWorkflow w) = ("workflow", (.id) w, workflowNodeLoc w)+nodeIdentity (NOperation o) = ("operation", (.name) o, (.loc) o)++validateNode :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> ProjectionSupplyAnalysis -> Spec -> Node -> [Diagnostic]+validateNode languageContract typeGraphResult _supplyAnalysis spec (NAggregate agg) = validateAggregate languageContract typeGraphResult spec agg+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NProcess p) = validateProcess languageContract spec p+validateNode languageContract typeGraphResult _supplyAnalysis spec (NRouter router) = validateRouter languageContract typeGraphResult spec router+validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NContract contract) = validateContract languageContract contract+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NIntake i) = validateIntake languageContract i ++ intakeCoupling languageContract spec i+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NEmit e) = validateEmit languageContract spec e+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NPublisher p) = validatePublisher languageContract spec p+validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NWorkqueue w) = validateWorkqueue languageContract w+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NPgmqDispatch d) = validatePgmqDispatch languageContract spec d+validateNode languageContract _typeGraphResult supplyAnalysis spec (NReadModel readModel) = validateReadModel languageContract supplyAnalysis spec readModel+validateNode languageContract _typeGraphResult _supplyAnalysis _spec (NProjectionTarget target) = validateProjectionTarget languageContract target+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NRebuildGroup groupNode) = validateRebuildGroup languageContract spec groupNode+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NProjectionRevision revision) = validateProjectionRevision languageContract spec revision+validateNode languageContract _typeGraphResult _supplyAnalysis spec (NExternalRead externalRead) = validateExternalRead languageContract spec externalRead+validateNode languageContract _typeGraphResult supplyAnalysis spec (NProjectionOwner owner) = validateProjectionOwner languageContract supplyAnalysis spec owner+validateNode _languageContract _typeGraphResult _supplyAnalysis _spec (NWorkflow w) = validateWorkflow w+validateNode _languageContract _typeGraphResult _supplyAnalysis spec (NOperation o) = validateOperation spec o++validateContract :: EffectiveLanguageContract -> ContractNode -> [Diagnostic]+validateContract languageContract contract =+  emptyContract+    <> typeIdPrefixErrors+    <> schemaVersionFloor+    <> topicNames+    <> duplicateEvents+    <> duplicateTopicAliases+    <> duplicateFields+    <> discriminatorShadows+    <> fieldWireKeyRules+    <> unresolvedTopicAliases+  where+    emptyContract =+      [ mkErr (locLine ((.loc) contract)) ContractEmpty $+          "contract '"+            <> (.name) contract+            <> "' declares no events; scaffold cannot lower an empty contract -- declare at least one event"+      | null ((.events) contract)+      ]+    typeIdPrefixErrors =+      [ mkErr (locLine ((.loc) field)) ContractInvalidTypeIdPrefix $+          "contract '"+            <> (.name) contract+            <> "' event '"+            <> (.name) event+            <> "' field '"+            <> (.name) field+            <> "' has invalid TypeID prefix '"+            <> prefix+            <> "': "+            <> T.pack (show reason)+      | event <- (.events) contract,+        field <- (.fields) event,+        CTypeId prefix <- [(.valueType) field],+        Just _ <- [contractIdDomainContractFor languageContract prefix],+        Just reason <- [TypeID.checkPrefix prefix]+      ]+    schemaVersionFloor =+      [ mkErr (locLine ((.loc) contract)) ContractSchemaVersionBelowMinimum $+          "contract '" <> (.name) contract <> "' schemaVersion must be at least 1"+      | enforcesSpecSurfaceClosures languageContract,+        (.schemaVersion) contract < 1+      ]+    topicNames =+      [ mkErr (locLine ((.loc) contract)) ContractTopicNameInvalid $+          "contract '" <> (.name) contract <> "' topic alias '" <> alias <> "' has invalid Kafka topic " <> T.pack (show topic) <> ": " <> reason+      | (alias, topic) <- (.topics) contract,+        T.null topic || enforcesSpecSurfaceClosures languageContract,+        Just reason <- [kafkaTopicError topic]+      ]+    duplicateEvents =+      [ mkErr (locLine ((.loc) contract)) ContractDuplicateEvent $+          "contract '" <> (.name) contract <> "' declares event '" <> (.name) event <> "' more than once"+      | event <- duplicatesBy (.name) ((.events) contract)+      ]+    duplicateTopicAliases =+      [ mkErr (locLine ((.loc) contract)) ContractDuplicateTopicAlias $+          "contract '" <> (.name) contract <> "' declares topic alias '" <> alias <> "' more than once"+      | (alias, _) <- duplicatesBy fst ((.topics) contract)+      ]+    duplicateFields =+      [ mkErr (locLine ((.loc) field)) ContractDuplicateFieldName $+          "contract '" <> (.name) contract <> "' event '" <> (.name) event <> "' declares field '" <> (.name) field <> "' more than once"+      | event <- (.events) contract,+        field <- duplicatesBy (.name) ((.fields) event)+      ]+    discriminatorShadows =+      [ mkErr (locLine ((.loc) field)) ContractFieldShadowsDiscriminator $+          "contract '"+            <> (.name) contract+            <> "' event '"+            <> (.name) event+            <> "' field '"+            <> (.name) field+            <> "' shadows the payload discriminator"+      | enforcesSpecSurfaceClosures languageContract,+        event <- (.events) contract,+        field <- (.fields) event,+        (.wireKey) (resolveContractFieldIdentity field) == (.discriminator) contract+      ]+    fieldWireKeyRules =+      concat+        [ wireKeyRulesForRecord+            ("contract '" <> (.name) contract <> "' event '" <> (.name) event <> "'")+            (Just ((.discriminator) contract, "payload discriminator"))+            (map resolveContractFieldIdentity ((.fields) event))+        | event <- (.events) contract+        ]+    unresolvedTopicAliases =+      [ mkErr (locLine ((.loc) contract)) ContractTopicAliasUnresolved $+          "contract '" <> (.name) contract <> "' event '" <> (.name) event <> "' names undeclared topic alias '" <> (.topic) event <> "'"+      | enforcesSpecSurfaceClosures languageContract,+        event <- (.events) contract,+        (.topic) event `notElem` map fst ((.topics) contract)+      ]++-- | Workflow replay keys, patch guards, rotation, and injected inputs must be unambiguous.+validateWorkflow :: WorkflowNode -> [Diagnostic]+validateWorkflow w = duplicateLabels ++ sleepFields ++ patchDuplicates ++ patchIds ++ continuePositions ++ idField+  where+    inputFields = map (.name) ((.inputFields) w)+    labelledItems = workflowLabelledItems ((.body) w)+    patchItems = workflowPatchItems ((.body) w)+    duplicateLabels =+      [ mkErr (locLine (wfBodyLoc item)) WorkflowDuplicateLabel $+          "workflow '" <> (.id) w <> "' declares label '" <> label <> "' more than once; labels key deterministic replay, so a duplicate label replays the first occurrence's journaled result"+      | (label, item) <- duplicatesBy fst labelledItems+      ]+    sleepFields =+      [ mkErr (locLine loc) WorkflowSleepDelayUnresolved $+          "workflow '" <> (.id) w <> "' sleep '" <> label <> "' references undeclared input field '" <> delay <> "'"+      | WfSleep label delay loc <- map snd labelledItems,+        delay `notElem` inputFields+      ]+    patchDuplicates =+      [ mkErr (locLine loc) WorkflowPatchDuplicate $+          "workflow '" <> (.id) w <> "' declares patch id '" <> patchId <> "' more than once; patch decisions journal under one stable key"+      | (patchId, _, loc) <- duplicatesBy (\(patchId, _, _) -> patchId) patchItems+      ]+    patchIds =+      [ mkErr (locLine loc) WorkflowPatchIdInvalid $+          "workflow '" <> (.id) w <> "' patch id '" <> patchId <> "' contains ':'; the runtime reserves that separator for the patch journal-key prefix"+      | (patchId, _, loc) <- patchItems,+        ":" `T.isInfixOf` patchId+      ]+    continuePositions =+      [ mkErr (locLine loc) WorkflowContinueAsNewNotTerminal $+          "workflow '" <> (.id) w <> "' continueAsNew must be the last top-level body item and may not appear inside a patch"+      | (isTopLevelTerminal, loc) <- workflowContinueItems ((.body) w),+        not isTopLevelTerminal+      ]+    idField = case (.idField) w of+      Just field+        | field `notElem` inputFields ->+            [ mkErr (locLine (workflowNodeLoc w)) WorkflowIdFieldUnresolved $+                "workflow '" <> (.id) w <> "' derives its id from undeclared input field '" <> field <> "'"+            ]+      _ -> []++wfBodyLoc :: WfBodyItem -> Loc+wfBodyLoc (WfStep _ _ loc) = loc+wfBodyLoc (WfAwait _ _ loc) = loc+wfBodyLoc (WfSleep _ _ loc) = loc+wfBodyLoc (WfChild _ _ _ loc) = loc+wfBodyLoc (WfPatch _ _ loc) = loc+wfBodyLoc (WfContinueAsNew _ loc) = loc++workflowLabelledItems :: [WfBodyItem] -> [(Name, WfBodyItem)]+workflowLabelledItems = concatMap go+  where+    go item@(WfStep label _ _) = [(label, item)]+    go item@(WfAwait label _ _) = [(label, item)]+    go item@(WfSleep label _ _) = [(label, item)]+    go item@(WfChild label _ _ _) = [(label, item)]+    go (WfPatch _ items _) = workflowLabelledItems items+    go WfContinueAsNew {} = []++workflowPatchItems :: [WfBodyItem] -> [(Name, [WfBodyItem], Loc)]+workflowPatchItems = concatMap go+  where+    go (WfPatch patchId items loc) = (patchId, items, loc) : workflowPatchItems items+    go _ = []++-- | Pair every rotation with whether it is the final top-level item.+workflowContinueItems :: [WfBodyItem] -> [(Bool, Loc)]+workflowContinueItems items = topLevel ++ nested+  where+    topLevel =+      [ (index == length items - 1, loc)+      | (index, WfContinueAsNew _ loc) <- zip [0 ..] items+      ]+    nested =+      [ (False, loc)+      | WfPatch _ patchBody _ <- items,+        (_, loc) <- workflowContinueItems patchBody+      ]++-- | A top-level rule is a total, clock-free function over one declared enum.+validateRule :: Spec -> RuleDecl -> [Diagnostic]+validateRule spec rule = case [e | e <- (.enums) spec, (.name) e == (.domain) rule] of+  [] ->+    [ mkErr rl RuleDomainUnresolved $+        "rule '" <> (.name) rule <> "' has undeclared enum domain '" <> (.domain) rule <> "'"+    ]+  (domain : _) -> totality domain ++ unknownCases domain ++ bodyDiagnostics+  where+    rl = locLine ((.loc) rule)+    caseNames = map fst ((.cases) rule)+    allEnumCtors = Set.fromList [ctor | e <- (.enums) spec, (ctor, _) <- (.ctors) e]+    totality domain =+      let missing = [ctor | (ctor, _) <- (.ctors) domain, ctor `notElem` caseNames]+       in [ mkErr rl RuleNotTotal $+              "rule '" <> (.name) rule <> "' is not total over enum '" <> (.name) domain <> "'; missing cases {" <> T.intercalate ", " missing <> "}"+          | not (null missing)+          ]+    unknownCases domain =+      [ mkErr rl RuleCaseUnknownCtor $+          "rule '" <> (.name) rule <> "' has case '" <> ctor <> "' which is not a constructor of enum '" <> (.name) domain <> "'"+      | (ctor, _) <- (.cases) rule,+        ctor `notElem` map fst ((.ctors) domain)+      ]+    bodyDiagnostics = concatMap validateBody ((.cases) rule)+    validateBody (ctor, expr) =+      [ mkErr rl ClockSampled $+          "rule '" <> (.name) rule <> "' case '" <> ctor <> "' samples the wall clock via '" <> atom <> "'; rules must be deterministic"+      | atom <- dedup (exprNames expr),+        atom `Set.member` clockAtoms+      ]+        ++ [ mkErr rl GuardAtomOutOfScope $+               "atom '" <> atom <> "' in rule '" <> (.name) rule <> "' resolves to no enum constructor or boolean literal"+           | atom <- dedup (exprNames expr),+             atom `Set.notMember` clockAtoms,+             atom `Set.notMember` allEnumCtors+           ]++-- | Operation rules resolve command aggregates, stream fields, projections,+-- read models, workflow signal labels and value types, and run targets.+validateOperation :: Spec -> OperationNode -> [Diagnostic]+validateOperation spec o = case (.shape) o of+  CommandOp aggregate streamField _ projections ->+    aggregateRef aggregate streamField ++ projectionRefs projections+  QueryOp readModel _ _ consistency ->+    resolveReadModelRef QueryUnresolvedReadModel spec ((.loc) o) ("query operation '" <> (.name) o <> "'") readModel+      ++ [ mkErr ol QueryConsistencyInvalid $+             "query operation '" <> (.name) o <> "' has unknown consistency '" <> consistency <> "'; expected Strong, Eventual, or PositionWait"+         | consistency `notElem` (["Strong", "Eventual", "PositionWait"] :: [Name])+         ]+  SignalOp lbl wf _ _ valueType ->+    case lookupWorkflow wf of+      Nothing ->+        [mkErr ol AwaitSignalMismatch ("signal operation '" <> (.name) o <> "' targets undeclared workflow '" <> wf <> "'")]+      Just w -> case [(resultType, loc) | (_, WfAwait label resultType loc) <- workflowLabelledItems ((.body) w), label == lbl] of+        [] ->+          [ mkErr ol AwaitSignalMismatch $+              "signal '" <> lbl <> "' of " <> wf <> " has no matching 'await' (workflow declares awaits {" <> T.intercalate ", " (awaitLabels w) <> "}); the deterministic awakeable id will not match and the workflow will wait forever"+          ]+        ((resultType, _) : _)+          | valueType == resultType -> []+          | otherwise ->+              [ mkErr ol AwaitSignalValueMismatch $+                  "signal '" <> lbl <> "' of " <> wf <> " carries value type '" <> valueType <> "' but the await expects '" <> resultType <> "'"+              ]+  RunOp wf _ _ ->+    [ mkErr ol RunWorkflowUnresolved ("run operation '" <> (.name) o <> "' targets undeclared workflow '" <> wf <> "'")+    | wf `notElem` map (.id) workflows+    ]+  where+    ol = locLine ((.loc) o)+    workflows = [w | NWorkflow w <- (.nodes) spec]+    aggregates = [a | NAggregate a <- (.nodes) spec]+    projectionTables = [(.table) p | a <- aggregates, Just p <- [(.projection) a]]+    lookupWorkflow n = case [w | w <- workflows, (.id) w == n] of (w : _) -> Just w; [] -> Nothing+    awaitLabels w = [l | (_, WfAwait l _ _) <- workflowLabelledItems ((.body) w)]+    aggregateRef name streamField = case [a | a <- aggregates, (.name) a == name] of+      [] ->+        [ mkErr ol OperationUnresolvedRef $+            "command operation '" <> (.name) o <> "' targets undeclared aggregate '" <> name <> "'"+        ]+      (aggregate : _) ->+        [ mkErr ol OperationUnresolvedRef $+            "command operation '" <> (.name) o <> "' stream field '" <> streamField <> "' is not declared by any command of aggregate '" <> name <> "'"+        | streamField `notElem` [(.name) field | command <- (.commands) aggregate, field <- (.fields) command]+        ]+    projectionRefs projections =+      [ mkErr ol OperationUnresolvedRef $+          "command operation '" <> (.name) o <> "' references undeclared projection table '" <> projection <> "'"+      | projection <- projections,+        projection `notElem` projectionTables+      ]++-- | Resolve a named read-model node using the caller's diagnostic code.+resolveReadModelRef :: DiagnosticCode -> Spec -> Loc -> Text -> Name -> [Diagnostic]+resolveReadModelRef diagnosticCode spec diagnosticLoc context name =+  [ mkErr (locLine diagnosticLoc) diagnosticCode $+      context <> " references undeclared readmodel '" <> name <> "'"+  | name `notElem` [(.name) readModel | NReadModel readModel <- (.nodes) spec]+  ]++validateProjectionCatalogFleet :: ProjectionSupplyAnalysis -> Spec -> [Diagnostic]+validateProjectionCatalogFleet supplyAnalysis spec = physicalDuplicates <> groupOwnership <> projectionOwnership <> targetDependencies <> handlerOrders <> sourceOrdering <> supplyDiagnostics+  where+    targets = [target | NProjectionTarget target <- (.nodes) spec]+    groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]+    owners = [owner | NProjectionOwner owner <- (.nodes) spec]+    physicalDuplicates =+      [ mkErr (locLine ((.loc) target)) CatalogPhysicalTargetDuplicate $+          "target '" <> (.name) target <> "' reuses physical table " <> (.schema) target <> "." <> (.table) target+      | target <- duplicatesBy (\target -> ((.schema) target, (.table) target)) targets+      ]+    targetClaims = [(targetName, (.name) groupNode, (.loc) groupNode) | groupNode <- groups, targetName <- (.targets) groupNode]+    groupOwnership =+      [ mkErr (locLine ((.loc) target)) CatalogTargetUnowned $+          "target '" <> (.name) target <> "' is not owned by any rebuild group"+      | target <- targets,+        null [() | (targetName, _, _) <- targetClaims, targetName == (.name) target]+      ]+        <> [ mkErr (locLine claimLoc) CatalogTargetMultiplyOwned $+               "target '" <> targetName <> "' is owned by more than one rebuild group"+           | (targetName, _, claimLoc) <- duplicatesBy (\(targetName, _, _) -> targetName) targetClaims+           ]+    projectionClaims = [(targetName, (.name) owner, (.loc) owner) | owner <- owners, targetName <- (.targets) owner]+    projectionOwnership =+      [ mkErr (locLine ((.loc) target)) CatalogTargetUnowned $+          "target '" <> (.name) target <> "' has no projection owner"+      | target <- targets,+        null [() | (targetName, _, _) <- projectionClaims, targetName == (.name) target]+      ]+        <> [ mkErr (locLine claimLoc) CatalogTargetMultiplyOwned $+               "target '" <> targetName <> "' is claimed by more than one projection owner"+           | (targetName, _, claimLoc) <- duplicatesBy (\(targetName, _, _) -> targetName) projectionClaims+           ]+    groupForTarget = Map.fromList [(targetName, groupName) | (targetName, groupName, _) <- targetClaims]+    targetDependencies =+      [ mkErr (locLine ((.loc) target)) CatalogTargetDependencyUnknown $+          "target '" <> (.name) target <> "' depends on undeclared target '" <> dependency <> "'"+      | target <- targets,+        dependency <- (.dependsOn) target,+        dependency `notElem` map (.name) targets+      ]+        <> [ mkErr (locLine ((.loc) target)) CatalogTargetDependencyOutsideGroup $+               "target '" <> (.name) target <> "' depends on target '" <> dependency <> "' in another rebuild group"+           | target <- targets,+             dependency <- (.dependsOn) target,+             Just ownerGroup <- [Map.lookup ((.name) target) groupForTarget],+             Just dependencyGroup <- [Map.lookup dependency groupForTarget],+             ownerGroup /= dependencyGroup+           ]+        <> [ mkErr (locLine ((.loc) target)) CatalogTargetDependencyCycle $+               "target dependency cycle includes '" <> (.name) target <> "'"+           | CyclicSCC cycleTargets <- stronglyConnComp [(target, (.name) target, (.dependsOn) target) | target <- targets],+             target <- cycleTargets+           ]+    handlerOrders =+      [ mkErr (locLine ((.loc) owner)) CatalogDuplicateHandlerOrder $+          "projection owner '" <> (.name) owner <> "' reuses handler order " <> T.pack (show ((.order) owner)) <> " in group '" <> (.group) owner <> "'"+      | owner <- duplicatesBy (\owner -> ((.group) owner, (.order) owner)) owners+      ]+    sourceOrdering =+      [ Diagnostic+          { line = locLine ((.loc) groupNode),+            severity = Error,+            code = CatalogAmbiguousSourceOrdering,+            relatedLocations =+              [ (locLine ((.loc) owner), "projection owner '" <> (.name) owner <> "' contributes " <> sourceScopeText owner <> " events")+              | owner <- groupOwners+              ],+            message =+              "rebuild group '"+                <> (.name) groupNode+                <> "' cannot combine an all-stream source with category-scoped sources; split them into separate rebuild groups"+          }+      | groupNode <- groups,+        let groupOwners = sortOn (.name) [owner | owner <- owners, (.group) owner == (.name) groupNode],+        any ownerUsesAllStreams groupOwners,+        any ownerUsesCategoryScope groupOwners+      ]+    ownerUsesAllStreams owner = CatalogAll `elem` (.sources) owner+    ownerUsesCategoryScope owner = any isCategoryScope ((.sources) owner)+    isCategoryScope CatalogAll = False+    isCategoryScope CatalogCategory {} = True+    isCategoryScope CatalogAggregate {} = True+    sourceScopeText owner+      | ownerUsesAllStreams owner = "all-stream"+      | otherwise = "category-scoped"+    supplyDiagnostics = concatMap projectionSupplyIssueDiagnostics ((.projectionSupplyIssues) supplyAnalysis)++projectionSupplyIssueDiagnostics :: ProjectionSupplyIssue -> [Diagnostic]+projectionSupplyIssueDiagnostics = \case+  SupplyObservedTargetsEmpty readModel ->+    [ mkErr (locLine ((.loc) readModel)) CatalogReadModelBindingMissing $+        "readmodel '" <> (.name) readModel <> "' must observe at least one target in its projection catalog group"+    ]+  SupplyObservedTargetUnknown readModel targetName ->+    [ mkErr (locLine ((.loc) readModel)) CatalogTargetUnknown $+        "readmodel '" <> (.name) readModel <> "' observes undeclared target '" <> targetName <> "'"+    ]+  SupplyObservedTargetOutsideGroup readModel targetName ->+    [ mkErr (locLine ((.loc) readModel)) CatalogReadModelTargetOutsideGroup $+        "readmodel '" <> (.name) readModel <> "' observes target '" <> targetName <> "' outside its bound group"+    ]+  SupplyObservedTargetWithoutOwner _ _ -> []+  SupplyObservedTargetWithMultipleOwners _ _ _ -> []+  SupplyOwnerGroupMismatch _ _ _ -> []+  SupplyQueryWithoutOwner readModel ->+    [ mkErr (locLine ((.loc) readModel)) CatalogReadModelSupplierMissing $+        "readmodel '" <> (.name) readModel <> "' does not resolve to one projection owner through its observed targets"+    ]+  SupplyQueryWithMultipleOwners readModel owners ->+    [ Diagnostic+        { line = locLine ((.loc) readModel),+          severity = Error,+          code = CatalogReadModelMultipleSuppliers,+          relatedLocations =+            [ (locLine ((.loc) owner), "projection owner '" <> (.name) owner <> "' supplies part of the observed target set")+            | owner <- sortOn (.name) owners+            ],+          message =+            "readmodel '"+              <> (.name) readModel+              <> "' spans several projection owners ("+              <> T.intercalate ", " (map (.name) (sortOn (.name) owners))+              <> "); split the query or declare one owner for the complete observed target set"+        }+    ]+  SupplyLegacyProjectionConflict readModel aggregate projection ->+    [ Diagnostic+        { line = locLine ((.loc) readModel),+          severity = Error,+          code = CatalogReadModelLegacyProjectionConflict,+          relatedLocations =+            [ ( locLine ((.loc) projection),+                "aggregate '" <> (.name) aggregate <> "' also names this readmodel in its legacy projection clause"+              )+            ],+          message =+            "catalog-bound readmodel '"+              <> (.name) readModel+              <> "' derives its supplier from projection-owner target ownership; remove the legacy aggregate projection clause"+        }+    ]++validateProjectionTarget :: EffectiveLanguageContract -> ProjectionTargetNode -> [Diagnostic]+validateProjectionTarget languageContract target =+  [ mkErr (locLine ((.loc) target)) ReadModelIdentifierInvalid $+      "target '" <> (.name) target <> "' " <> kind <> " " <> T.pack (show identifier) <> " is not a PostgreSQL unquoted identifier"+  | hasProjectionCatalog languageContract,+    (kind, identifier) <- [("schema", (.schema) target), ("table", (.table) target)],+    not (validPostgresIdentifier identifier)+  ]++validateRebuildGroup :: EffectiveLanguageContract -> Spec -> RebuildGroupNode -> [Diagnostic]+validateRebuildGroup languageContract spec groupNode+  | not (hasProjectionCatalog languageContract) = []+  | otherwise = emptyTargets <> unknownTargets <> invalidOrder+  where+    targetNames = [(.name) target | NProjectionTarget target <- (.nodes) spec]+    emptyTargets =+      [ mkErr (locLine ((.loc) groupNode)) CatalogGroupEmpty $+          "rebuild group '" <> (.name) groupNode <> "' must own at least one target"+      | null ((.targets) groupNode)+      ]+    unknownTargets =+      [ mkErr (locLine ((.loc) groupNode)) CatalogTargetUnknown $+          "rebuild group '" <> (.name) groupNode <> "' references undeclared target '" <> targetName <> "'"+      | targetName <- (.targets) groupNode,+        targetName `notElem` targetNames+      ]+    invalidOrder =+      [ mkErr (locLine ((.loc) groupNode)) CatalogGroupOrderMismatch $+          "rebuild group '" <> (.name) groupNode <> "' order must contain each owned target exactly once"+      | Set.fromList ((.order) groupNode) /= Set.fromList ((.targets) groupNode)+          || length ((.order) groupNode) /= Set.size (Set.fromList ((.order) groupNode))+          || length ((.targets) groupNode) /= Set.size (Set.fromList ((.targets) groupNode))+      ]++validateProjectionRevision :: EffectiveLanguageContract -> Spec -> ProjectionRevisionNode -> [Diagnostic]+validateProjectionRevision languageContract spec revisionNode+  | not (hasProjectionCatalog languageContract) = []+  | otherwise = noTargets <> unknownGroup <> unknownTargets <> duplicateTargets <> targetSetMismatch <> invalidIdentities <> invalidPromotionNames+  where+    declaredTargets = [(.name) target | NProjectionTarget target <- (.nodes) spec]+    matchingGroups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec, (.name) groupNode == (.group) revisionNode]+    revisionTargets = (.targets) revisionNode+    revisionTargetNames = map (.target) revisionTargets+    noTargets =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionNoTarget $+          "projection revision '" <> (.name) revisionNode <> "' must declare every target in its rebuild group"+      | null revisionTargets+      ]+    unknownGroup =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionGroupUnknown $+          "projection revision '" <> (.name) revisionNode <> "' references undeclared rebuild group '" <> (.group) revisionNode <> "'"+      | null matchingGroups+      ]+    unknownTargets =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionTargetUnknown $+          "projection revision '" <> (.name) revisionNode <> "' references undeclared target '" <> (.target) revisionTarget <> "'"+      | revisionTarget <- revisionTargets,+        (.target) revisionTarget `notElem` declaredTargets+      ]+    duplicateTargets =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionDuplicateTarget $+          "projection revision '" <> (.name) revisionNode <> "' declares target '" <> targetName <> "' more than once"+      | targetName <- duplicatesBy id revisionTargetNames+      ]+    targetSetMismatch =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionTargetSetMismatch $+          "projection revision '" <> (.name) revisionNode <> "' target set must equal rebuild group '" <> (.group) revisionNode <> "'"+      | groupNode : _ <- [matchingGroups],+        Set.fromList revisionTargetNames /= Set.fromList ((.targets) groupNode)+          || length revisionTargetNames /= Set.size (Set.fromList revisionTargetNames)+      ]+    invalidIdentities =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionIdentityInvalid $+          "projection revision '" <> (.name) revisionNode <> "' target '" <> (.target) revisionTarget <> "' has invalid " <> identityKind <> " identity/version"+      | revisionTarget <- revisionTargets,+        (identityKind, identity, version) <-+          [ ("schema", (.schemaVersion) revisionTarget, 1),+            ("provisioner", (.provisioner) revisionTarget, (.provisionerVersion) revisionTarget),+            ("expected-shape", (.expectedShape) revisionTarget, 1),+            ("validator", (.validator) revisionTarget, (.validatorVersion) revisionTarget)+          ],+        T.null identity || T.strip identity /= identity || version <= 0+      ]+    invalidPromotionNames =+      [ mkErr (locLine ((.loc) revisionNode)) CatalogRevisionPromotionNameInvalid $+          "projection revision '" <> (.name) revisionNode <> "' target '" <> (.target) revisionTarget <> "' promotion names must be valid, unique PostgreSQL identifiers"+      | revisionTarget <- revisionTargets,+        let objects = (.promotionObjects) revisionTarget+            names = concat [[(.generationName) object, (.canonicalName) object] | object <- objects],+        any (not . validPostgresIdentifier) names+          || length names /= Set.size (Set.fromList names)+      ]++validateExternalRead :: EffectiveLanguageContract -> Spec -> ExternalReadNode -> [Diagnostic]+validateExternalRead languageContract spec externalRead+  | not (hasProjectionCatalog languageContract) = []+  | otherwise =+      invalidIdentity+        <> invalidVersion+        <> unknownQuery+        <> invalidTargetCardinality+        <> invalidCompatibility+        <> unknownRevisions+        <> revisionGroupMismatch+        <> invalidSurfaceGeneration+  where+    diagnosticLine = locLine ((.loc) externalRead)+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]+    revisions = [revision | NProjectionRevision revision <- (.nodes) spec]+    matchingReadModels = [readModel | readModel <- readModels, (.name) readModel == (.queryModel) externalRead]+    matchingGroup = case matchingReadModels of+      readModel : _ -> (.group) readModel+      [] -> Nothing+    invalidIdentity =+      [ mkErr diagnosticLine CatalogExternalReadIdentityInvalid $+          "external-read '"+            <> (.name) externalRead+            <> "' requires lower-case PostgreSQL identifiers for its contract, result schema, and result type"+      | any+          (not . validPostgresIdentifier)+          [(.name) externalRead, (.resultSchema) externalRead, (.resultType) externalRead]+      ]+    invalidVersion =+      [ mkErr diagnosticLine CatalogExternalReadVersionInvalid $+          "external-read '" <> (.name) externalRead <> "' version must be at least 1"+      | (.version) externalRead <= 0+      ]+    unknownQuery =+      [ mkErr diagnosticLine CatalogExternalReadQueryUnknown $+          "external-read '" <> (.name) externalRead <> "' references undeclared readmodel '" <> (.queryModel) externalRead <> "'"+      | null matchingReadModels+      ]+    invalidTargetCardinality =+      [ mkErr diagnosticLine CatalogExternalReadTargetCardinalityInvalid $+          "external-read '"+            <> (.name) externalRead+            <> "' is the bounded all-row form and its readmodel must observe exactly one target"+      | readModel <- take 1 matchingReadModels,+        length ((.observedTargets) readModel) /= 1+      ]+    compatibleRevisions = (.compatibleRevisions) externalRead+    invalidCompatibility =+      [ mkErr diagnosticLine CatalogExternalReadCompatibilityInvalid $+          "external-read '" <> (.name) externalRead <> "' must name at least one compatible projection revision without duplicates"+      | null compatibleRevisions+          || length compatibleRevisions /= Set.size (Set.fromList compatibleRevisions)+      ]+    unknownRevisions =+      [ mkErr diagnosticLine CatalogExternalReadRevisionUnknown $+          "external-read '" <> (.name) externalRead <> "' references undeclared projection revision '" <> revisionName <> "'"+      | revisionName <- compatibleRevisions,+        revisionName `notElem` map (.name) revisions+      ]+    revisionGroupMismatch =+      [ mkErr diagnosticLine CatalogExternalReadRevisionGroupMismatch $+          "external-read '"+            <> (.name) externalRead+            <> "' binds readmodel group '"+            <> queryGroup+            <> "' but compatible revision '"+            <> revisionName+            <> "' belongs to group '"+            <> (.group) revision+            <> "'"+      | Just queryGroup <- [matchingGroup],+        revisionName <- compatibleRevisions,+        revision <- revisions,+        (.name) revision == revisionName,+        (.group) revision /= queryGroup+      ]+    invalidSurfaceGeneration =+      [ mkErr diagnosticLine CatalogExternalReadSurfaceGenerationInvalid $+          "external-read '" <> (.name) externalRead <> "' surface-generation must be at least 1"+      | (.surfaceGeneration) externalRead <= 0+      ]++validateProjectionOwner :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> ProjectionOwnerNode -> [Diagnostic]+validateProjectionOwner languageContract supplyAnalysis spec owner+  | not (hasProjectionCatalog languageContract) = []+  | otherwise = noSources <> noTargets <> unknownGroup <> outsideGroup <> sourceRules <> identityRules <> checkpointRules <> asyncQueryBinding <> replayRules+  where+    groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]+    targets = [target | NProjectionTarget target <- (.nodes) spec]+    aggregates = [(.name) aggregate | NAggregate aggregate <- (.nodes) spec]+    selectedGroupTargets = case [(.targets) groupNode | groupNode <- groups, (.name) groupNode == (.group) owner] of+      groupTargets : _ -> groupTargets+      [] -> []+    noSources =+      [mkErr (locLine ((.loc) owner)) CatalogProjectionNoSource ("projection owner '" <> (.name) owner <> "' must declare at least one source") | null ((.sources) owner)]+    noTargets =+      [mkErr (locLine ((.loc) owner)) CatalogProjectionNoTarget ("projection owner '" <> (.name) owner <> "' must declare at least one target") | null ((.targets) owner)]+    unknownGroup =+      [ mkErr (locLine ((.loc) owner)) CatalogGroupUnknown $+          "projection owner '" <> (.name) owner <> "' references undeclared rebuild group '" <> (.group) owner <> "'"+      | (.group) owner `notElem` map (.name) groups+      ]+    outsideGroup =+      [ mkErr (locLine ((.loc) owner)) CatalogProjectionTargetOutsideGroup $+          "projection owner '" <> (.name) owner <> "' writes target '" <> targetName <> "' outside group '" <> (.group) owner <> "'"+      | targetName <- (.targets) owner,+        targetName `notElem` selectedGroupTargets+      ]+    sourceRules =+      [ mkErr (locLine ((.loc) owner)) CatalogSourceUnresolved $+          "projection owner '" <> (.name) owner <> "' references undeclared aggregate source '" <> aggregateName <> "'"+      | CatalogAggregate aggregateName <- (.sources) owner,+        aggregateName `notElem` aggregates+      ]+        <> [ mkErr (locLine ((.loc) owner)) CatalogSourceOverlap $+               "projection owner '" <> (.name) owner <> "' must select exactly one typed replay source; split independent sources into separate owners"+           | length ((.sources) owner) > 1+           ]+        <> [ mkErr (locLine ((.loc) owner)) RuntimeIdentityInvalid $+               "projection owner '" <> (.name) owner <> "' category source " <> T.pack (show categoryName) <> " " <> reason+           | CatalogCategory categoryName <- (.sources) owner,+             Just reason <- [runtimeIdentityError False categoryName]+           ]+    identityRules = case (.delivery) owner of+      DeliverySubscription ->+        [ mkErr (locLine ((.loc) owner)) CatalogAsyncIdentityMissing $+            "projection owner '" <> (.name) owner <> "' with subscription delivery requires both subscription and dedup identities"+        | (.subscription) owner == Nothing || (.dedup) owner == Nothing+        ]+      DeliveryInline ->+        [ mkErr (locLine ((.loc) owner)) CatalogInlineIdentityUnexpected $+            "projection owner '" <> (.name) owner <> "' with inline delivery cannot declare subscription or dedup identities"+        | (.subscription) owner /= Nothing || (.dedup) owner /= Nothing+        ]+    checkpointRules = case (.delivery) owner of+      DeliverySubscription ->+        [ mkErr (locLine ((.loc) owner)) CatalogCheckpointPolicyMissing $+            "projection owner '" <> (.name) owner <> "' with subscription delivery requires exactly one checkpoint-on-missing policy"+        | null ((.checkpointOnMissing) owner)+        ]+          <> [ mkErr (locLine ((.loc) owner)) CatalogCheckpointPolicyDuplicate $+                 "projection owner '" <> (.name) owner <> "' declares checkpoint-on-missing more than once; choose exactly one of from-beginning, from-current-head, or fail"+             | length ((.checkpointOnMissing) owner) > 1+             ]+      DeliveryInline ->+        [ mkErr (locLine ((.loc) owner)) CatalogCheckpointPolicyUnexpected $+            "projection owner '" <> (.name) owner <> "' with inline delivery cannot declare checkpoint-on-missing because inline delivery has no durable subscription checkpoint"+        | not (null ((.checkpointOnMissing) owner))+        ]+    asyncQueryBinding =+      [ mkErr (locLine ((.loc) owner)) CatalogAsyncQueryBindingMissing $+          "projection owner '" <> (.name) owner <> "' has no query model in group '" <> (.group) owner <> "' observing one of its targets"+      | (.delivery) owner == DeliverySubscription,+        null+          [ ()+          | supply <- (.resolvedProjectionSupplies) supplyAnalysis,+            (.projectionOwner) supply == (.name) owner+          ]+      ]+    replayRules =+      [ mkErr (locLine ((.loc) owner)) CatalogClearTargetLiveOnly $+          "projection owner '" <> (.name) owner <> "' is live-only but writes a clear-before-replay target"+      | ProjectionLiveOnly _ <- [(.replay) owner],+        target <- targets,+        (.name) target `elem` (.targets) owner,+        (.reset) target == TargetClear+      ]+        <> [ mkErr (locLine ((.loc) owner)) CatalogCheckpointPolicyReplayUnsafe $+               "projection owner '" <> (.name) owner <> "' uses from-current-head for subscription '" <> fromMaybe "" ((.subscription) owner) <> "' while replayable target '" <> (.name) target <> "' is cleared before replay; use from-beginning or fail"+           | (.delivery) owner == DeliverySubscription,+             (.checkpointOnMissing) owner == [CheckpointFromCurrentHead],+             (.replay) owner == ProjectionReplayExplicit,+             target <- targets,+             (.name) target `elem` (.targets) owner,+             (.reset) target == TargetClear+           ]++-- | Validate captured identity, feed semantics, and the declared column surface.+validateReadModel :: EffectiveLanguageContract -> ProjectionSupplyAnalysis -> Spec -> ReadModelNode -> [Diagnostic]+validateReadModel languageContract supplyAnalysis spec readModel =+  shapeFixture ++ columnTypes ++ strongFeed ++ scopeMode ++ inlineSubscription ++ inlineReference ++ freshnessCapability ++ versionFloor ++ identifiers ++ runtimeIdentities ++ duplicateColumns ++ catalogBinding+  where+    readModelLine = locLine ((.loc) readModel)+    expectedShape = deriveShapeHash readModel+    shapeFixture =+      [ mkErr readModelLine RmShapeHashDrift $+          "readmodel '"+            <> (.name) readModel+            <> "': captured shape \""+            <> (.shape) readModel+            <> "\" does not match the declared columns (expected \""+            <> expectedShape+            <> "\"); update the fixture AND bump version if the table shape really changed"+      | (.shape) readModel /= expectedShape+      ]+    allowedColumnTypes = Set.fromList ["text", "int", "bigint", "bool", "timestamptz", "jsonb", "numeric"]+    columnTypes =+      [ mkErr readModelLine RmUnknownColumnType $+          "readmodel '" <> (.name) readModel <> "' column '" <> (.rmcName) columnDecl <> "' has unknown type '" <> (.rmcType) columnDecl <> "'"+      | columnDecl <- (.columns) readModel,+        (.rmcType) columnDecl `Set.notMember` allowedColumnTypes+      ]+    strongFeed =+      [ mkErr readModelLine RmStrongInlineOnly $+          "readmodel '"+            <> (.name) readModel+            <> "': consistency = Strong with feed = inline; an inline-only model has no subscription worker to advance the cursor a Strong read waits on. Use consistency = Eventual, or feed = subscription"+      | legacyReadModelFeed readModel == Just RmInline,+        legacyReadModelConsistency readModel == Just Strong+      ]+    scopeMode =+      [ mkErr readModelLine RmScopeWithoutStrong $+          "readmodel '" <> (.name) readModel <> "': scope is meaningful only with consistency = Strong"+      | legacyReadModelScope readModel /= Nothing,+        legacyReadModelConsistency readModel /= Just Strong+      ]+    inlineSubscription =+      [ Diagnostic+          { line = readModelLine,+            severity = Warning,+            code = RmInlineSubscriptionIgnored,+            relatedLocations = [],+            message = "readmodel '" <> (.name) readModel <> "': subscription override is ignored when feed = inline; remove it or select feed = subscription"+          }+      | legacyReadModelFeed readModel == Just RmInline,+        legacyReadModelSubscription readModel /= Nothing+      ]+    inlineReference+      | hasProjectionCatalog languageContract,+        (.group) readModel /= Nothing =+          []+      | otherwise =+          [ mkErr readModelLine RmInlineFeedUnreferenced $+              "readmodel '" <> (.name) readModel <> "' declares feed = inline but no aggregate projection references it"+          | legacyReadModelFeed readModel == Just RmInline,+            (.name) readModel `notElem` [(.table) projection | NAggregate aggregate <- (.nodes) spec, Just projection <- [(.projection) aggregate]]+          ]+    freshnessCapability+      | not (hasSeparatedProjectionQueryPolicy languageContract) = []+      | otherwise = case (.freshness) readModel of+          FreshnessImmediate -> []+          requested@(FreshnessWaitForHead requestedScope) ->+            case resolvedOwner of+              Nothing+                | not (null implicitProjectionOwners) ->+                    [ waitError+                        CatalogQueryWaitWithoutCompatibleCursor+                        requested+                        "implicit aggregate projection"+                        "inline"+                        []+                        "move the projection into a subscription projection-owner or use freshness = immediate"+                    ]+                | otherwise -> []+              Just owner ->+                case compatibleCursorCandidates requestedScope owner of+                  [] ->+                    [ waitError+                        CatalogQueryWaitWithoutCompatibleCursor+                        requested+                        ("projection-owner '" <> (.name) owner <> "'")+                        (deliveryText ((.delivery) owner))+                        (allCursorCandidates owner)+                        "use freshness = immediate or give the supplying owner one compatible subscription cursor"+                    ]+                  [_] -> []+                  candidates ->+                    [ waitError+                        CatalogQueryWaitWithAmbiguousCursor+                        requested+                        ("projection-owner '" <> (.name) owner <> "'")+                        (deliveryText ((.delivery) owner))+                        candidates+                        "leave exactly one compatible subscription cursor or use freshness = immediate"+                    ]+      where+        resolvedOwner = do+          ownerName <- case [ (.projectionOwner) supply+                            | supply <- (.resolvedProjectionSupplies) supplyAnalysis,+                              (.queryModel) supply == (.name) readModel+                            ] of+            [name] -> Just name+            _ -> Nothing+          case [owner | NProjectionOwner owner <- (.nodes) spec, (.name) owner == ownerName] of+            [owner] -> Just owner+            _ -> Nothing+        implicitProjectionOwners =+          [ aggregate+          | NAggregate aggregate <- (.nodes) spec,+            Just projection <- [(.projection) aggregate],+            (.table) projection == (.name) readModel+          ]+        compatibleCursorCandidates scope owner+          | (.delivery) owner /= DeliverySubscription = []+          | not (any (sourceReaches scope) ((.sources) owner)) = []+          | otherwise = allCursorCandidates owner+        allCursorCandidates owner = case (.subscription) owner of+          Just subscription -> [subscription]+          Nothing -> []+        sourceReaches RmEntireLog CatalogAll = True+        sourceReaches RmEntireLog _ = False+        sourceReaches (RmCategory _) CatalogAll = True+        sourceReaches (RmCategory wanted) (CatalogCategory actual) = wanted == actual+        sourceReaches (RmCategory wanted) (CatalogAggregate aggregateName) = wanted == lowerInitial aggregateName+        lowerInitial value = case T.uncons value of+          Nothing -> value+          Just (first, rest) -> T.cons (toLower first) rest+        deliveryText DeliveryInline = "inline"+        deliveryText DeliverySubscription = "subscription"+        freshnessText FreshnessImmediate = "immediate"+        freshnessText (FreshnessWaitForHead RmEntireLog) = "wait-for-head entire-log"+        freshnessText (FreshnessWaitForHead (RmCategory category)) = "wait-for-head category " <> T.pack (show category)+        waitError diagnosticCode requested ownerText delivery candidates remedy =+          mkErr readModelLine diagnosticCode $+            "readmodel '"+              <> (.name) readModel+              <> "' requests "+              <> freshnessText requested+              <> " but its supplying "+              <> ownerText+              <> " has delivery capabilities "+              <> delivery+              <> " and compatible cursor candidates "+              <> (if null candidates then "none" else T.intercalate ", " (sortOn id candidates))+              <> "; remedy: "+              <> remedy+    versionFloor =+      [ mkErr readModelLine ReadModelVersionBelowMinimum $+          "readmodel '" <> (.name) readModel <> "' version must be at least 1"+      | enforcesSpecSurfaceClosures languageContract,+        (.version) readModel < 1+      ]+    identifiers =+      [ mkErr readModelLine ReadModelIdentifierInvalid $+          "readmodel '" <> (.name) readModel <> "' " <> kind <> " " <> T.pack (show identifier) <> " is not a PostgreSQL unquoted identifier"+      | enforcesSpecSurfaceClosures languageContract,+        (kind, identifier) <-+          [ (kind, identifier)+          | (.group) readModel == Nothing,+            (kind, identifier) <- [("schema", (.schema) readModel), ("table", (.table) readModel)]+          ]+            <> [("column", (.rmcName) columnDecl) | columnDecl <- (.columns) readModel],+        not (validPostgresIdentifier identifier)+      ]+    runtimeIdentities =+      [ mkErr readModelLine RuntimeIdentityInvalid $+          "readmodel '" <> (.name) readModel <> "' subscription " <> T.pack (show subscription) <> " " <> reason+      | enforcesSpecSurfaceClosures languageContract,+        Just subscription <- [legacyReadModelSubscription readModel],+        Just reason <- [stableIdentityError subscription]+      ]+        ++ [ mkErr readModelLine RuntimeIdentityInvalid $+               "readmodel '" <> (.name) readModel <> "' scope category " <> T.pack (show category) <> " " <> reason+           | enforcesSpecSurfaceClosures languageContract,+             Just (RmCategory category) <- [readModelScopeForIdentity readModel],+             Just reason <- [runtimeIdentityError False category]+           ]+    readModelScopeForIdentity model = case (.supply) model of+      LegacyReadModelSupply {legacyScope} -> legacyScope+      OwnerDerivedSupply -> case (.freshness) model of+        FreshnessImmediate -> Nothing+        FreshnessWaitForHead scope -> Just scope+    duplicateColumns =+      [ mkErr readModelLine ReadModelDuplicateColumn $+          "readmodel '" <> (.name) readModel <> "' declares column '" <> (.rmcName) columnDecl <> "' more than once"+      | enforcesSpecSurfaceClosures languageContract,+        columnDecl <- duplicatesBy (.rmcName) ((.columns) readModel)+      ]+    catalogBinding+      | not (hasProjectionCatalog languageContract) = []+      | otherwise = missingGroup <> unknownGroup <> physicalOverride <> backingRequired <> backingUnobserved+      where+        groups = [groupNode | NRebuildGroup groupNode <- (.nodes) spec]+        missingGroup =+          [ mkErr readModelLine CatalogReadModelBindingMissing $+              "readmodel '" <> (.name) readModel <> "' must bind to a projection catalog group or be referenced by one legacy aggregate projection"+          | (.group) readModel == Nothing,+            null+              [ ()+              | NAggregate aggregate <- (.nodes) spec,+                Just projection <- [(.projection) aggregate],+                (.table) projection == (.name) readModel+              ]+          ]+        unknownGroup =+          [ mkErr readModelLine CatalogGroupUnknown $+              "readmodel '" <> (.name) readModel <> "' references undeclared rebuild group '" <> groupName <> "'"+          | Just groupName <- [(.group) readModel],+            groupName `notElem` map (.name) groups+          ]+        physicalOverride =+          [ mkErr readModelLine CatalogReadModelPhysicalOverride $+              "readmodel '"+                <> (.name) readModel+                <> "' binds to group '"+                <> groupName+                <> "' but declares explicit table/schema; physical coordinates belong to the target declaration — remove table/schema and name the intended target in 'targets' (and 'backing' when observing several)"+          | Just groupName <- [(.group) readModel],+            (.table) readModel /= "" || (.schema) readModel /= ""+          ]+        backingRequired =+          [ mkErr readModelLine CatalogReadModelBackingRequired $+              "readmodel '"+                <> (.name) readModel+                <> "' observes "+                <> T.pack (show (length ((.observedTargets) readModel)))+                <> " targets; name the physical backing target with 'backing = <target>'"+          | (.group) readModel /= Nothing,+            length ((.observedTargets) readModel) > 1,+            (.backingTarget) readModel == Nothing+          ]+        backingUnobserved =+          [ mkErr readModelLine CatalogReadModelBackingUnobserved $+              "readmodel '"+                <> (.name) readModel+                <> "' names backing target '"+                <> backingTarget+                <> "' but does not observe it"+          | Just backingTarget <- [(.backingTarget) readModel],+            backingTarget `notElem` (.observedTargets) readModel+          ]++-- | EP-5 workqueue rules: the captured physical name must match the queueRef+-- derivation; the disposition inversions (storeFailure transient => must retry;+-- decodeFailure poison => must dead-letter); and dlq=on requires a retry ceiling.+validateWorkqueue :: EffectiveLanguageContract -> WorkqueueNode -> [Diagnostic]+validateWorkqueue languageContract w = concat [divergence, completeness, duplicateRows, inversions, retryCeiling, orderingRules, groupKeyRules, payloadTypes, windows, provisionRules]+  where+    wl = locLine ((.loc) w)+    rows = (.disposition) w+    (derivedPhysical, derivedDlq, derivedTable) = derivedQueueTrio ((.logical) w)+    divergence =+      [ mkErr wl WqPhysicalDivergence $+          "workqueue '" <> (.name) w <> "': captured physical \"" <> (.physical) w <> "\" diverges from queueRef(\"" <> (.logical) w <> "\") = \"" <> derivedPhysical <> "\""+      | (.physical) w /= derivedPhysical+      ]+        ++ [ mkErr wl WqDlqDivergence $+               "workqueue '" <> (.name) w <> "': captured dlq \"" <> (.dlq) w <> "\" diverges from queueRef = \"" <> derivedDlq <> "\""+           | (.dlq) w /= derivedDlq+           ]+        ++ [ mkErr wl WqTableDivergence $+               "workqueue '" <> (.name) w <> "': captured table \"" <> (.table) w <> "\" diverges from queueRef table = \"" <> derivedTable <> "\""+           | (.table) w /= derivedTable+           ]+    requiredOutcomes = ["storeFailure", "commandRejected", "decodeFailure", "onCodecReject"]+    completeness =+      [ mkErr wl WqDispositionIncomplete $+          "workqueue '" <> (.name) w <> "' disposition table is missing outcome '" <> outcome <> "'"+      | outcome <- requiredOutcomes,+        outcome `notElem` map (.outcome) rows+      ]+    duplicateRows =+      [ mkErr (locLine ((.loc) row)) DispositionDuplicateOutcome $+          "workqueue '" <> (.name) w <> "' repeats disposition outcome '" <> (.outcome) row <> "'; the first row would shadow this row"+      | row <- duplicatesBy (.outcome) rows+      ]+    firstRow outcome = case [row | row <- rows, (.outcome) row == outcome] of+      (row : _) -> Just row+      [] -> Nothing+    isRetry row = case (.action) row of IRetry _ -> True; _ -> False+    isDeadLetter row = case (.action) row of IDeadLetter _ -> True; _ -> False+    inversions =+      [ mkErr (locLine ((.loc) row)) WqStoreFailureNotRetry ("workqueue '" <> (.name) w <> "': 'storeFailure' is transient and MUST retry, not dead-letter")+      | Just row <- [firstRow "storeFailure"],+        isDeadLetter row+      ]+        ++ [ mkErr (locLine ((.loc) row)) WqDecodeFailureNotDeadLetter ("workqueue '" <> (.name) w <> "': 'decodeFailure' is poison and MUST dead-letter, not retry")+           | Just row <- [firstRow "decodeFailure"],+             isRetry row+           ]+    retryCeiling =+      [ mkErr wl WqDlqWithoutCeiling ("workqueue '" <> (.name) w <> "': dlq=on requires maxRetries >= 1 (an absent ceiling never dead-letters)")+      | (.dlqOn) w && (.maxRetries) w < 1+      ]+    fifo = (.ordering) w /= WqUnordered+    orderingRules =+      [ mkErr wl WqGroupKeyMissing $+          "workqueue '" <> (.name) w <> "': FIFO delivery is per group, so ordering requires a 'group key' clause that makes enqueueToGroup deterministic"+      | fifo && (.groupKey) w == Nothing+      ]+        ++ [ mkErr wl WqGroupKeyWithoutFifo $+               "workqueue '" <> (.name) w <> "': a group key with unordered reads would be ignored; declare a FIFO ordering or remove the key"+           | not fifo && (.groupKey) w /= Nothing+           ]+    groupKeyRules = case (.groupKey) w of+      Nothing -> []+      Just groupKey ->+        case [field | field <- (.payload) w, (.name) field == (.field) groupKey] of+          [] ->+            [ mkErr wl WqGroupKeyUnresolved $+                "workqueue '" <> (.name) w <> "': group key field '" <> (.field) groupKey <> "' is not declared in its payload"+            ]+          field : _ ->+            [ mkErr wl WqGroupKeyUnresolved $+                "workqueue '" <> (.name) w <> "': group key via raw requires a text payload field, but '" <> (.field) groupKey <> "' has type '" <> queuePayloadTypeText ((.valueType) field) <> "'"+            | (.via) groupKey == "raw" && not (isDirectText ((.valueType) field))+            ]+              ++ [ mkErr wl WqGroupKeyUnresolved $+                     "workqueue '" <> (.name) w <> "': opaque group-key derivation '" <> (.via) groupKey <> "' requires a captured fixture"+                 | (.via) groupKey /= "raw" && (.fixture) groupKey == Nothing+                 ]+    payloadTypes =+      [ mkErr wl WqPayloadTypeUnknown $+          "workqueue '" <> (.name) w <> "' payload field '" <> (.name) field <> "' has unknown type '" <> queueScalarName scalar <> "'; expected text, int, or bool"+      | enforcesSpecSurfaceClosures languageContract,+        field <- (.payload) w,+        LegacyQueueScalar scalar@(QueueOther _) <- [(.valueType) field]+      ]+    isDirectText (LegacyQueueScalar QueueText) = True+    isDirectText (TypedQueueExpression TText) = True+    isDirectText _ = False+    queuePayloadTypeText (LegacyQueueScalar scalar) = queueScalarName scalar+    queuePayloadTypeText (TypedQueueExpression _) = "mapped expression"+    windows =+      windowRangeRule languageContract wl ("workqueue '" <> (.name) w <> "' delay") ((.delay) w)+        ++ concat+          [ windowRangeRule languageContract (locLine ((.loc) row)) ("workqueue '" <> (.name) w <> "' retry") window+          | row <- rows,+            IRetry window <- [(.action) row]+          ]+    provisionRules = case (.provision) w of+      WqStandard -> []+      WqUnlogged ->+        [ Diagnostic+            { line = wl,+              severity = Warning,+              code = WqUnloggedDurability,+              relatedLocations = [],+              message = "workqueue '" <> (.name) w <> "': provision unlogged is truncated to empty on a database crash; use it only for transient, regenerable work"+            }+        ]+      WqPartitioned interval retention ->+        [ mkErr wl WqPartitionSpecEmpty $+            "workqueue '" <> (.name) w <> "': partition interval and retention must be non-empty; they are create-time settings and the additive reconciler will not migrate an existing queue"+        | T.null interval || T.null retention+        ]++-- | EP-5 dispatch rule: the @enqueue to@ target must resolve to a declared workqueue.+validatePgmqDispatch :: EffectiveLanguageContract -> Spec -> PgmqDispatchNode -> [Diagnostic]+validatePgmqDispatch languageContract spec d = enqueueRef ++ dedupQueueRef ++ sourceReadModelRef ++ sourceReadModelField ++ dedupReadModelRef ++ dedupReadModelField ++ dedupKeyField ++ fanoutFunctionName+  where+    dl = locLine ((.loc) d)+    -- The top-level `dedup key` is the logical value being deduped. Its two+    -- physical locations are already checked against the seenIn read model and+    -- queue; the key itself comes from the source read model's row, so it must+    -- be one of that model's generated selectors — exactly the rule `source key`+    -- already obeys. ExecPlan 197 parked this as descriptive-only.+    dedupKeyField = case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.sourceReadModel) d] of+      [] -> []+      readModel : _ ->+        [ mkSurfaceRefusal languageContract dl DispatchReadModelFieldUnknown $+            "dispatch '"+              <> (.name) d+              <> "' dedup key '"+              <> (.dedupKey) d+              <> "' is not a generated logical selector for a column of source readmodel '"+              <> (.sourceReadModel) d+              <> "'"+        | (.dedupKey) d `notElem` map (logicalFieldSelector . (.rmcName)) ((.columns) readModel)+        ]++    -- `fanout body` names a hand-written function that expands one source row+    -- into queued jobs. A pgmq dispatch generates no module, so there is no+    -- typed namespace to resolve the name against — but a name that is not a+    -- legal Haskell value identifier cannot be the name of any function anyone+    -- could write, which is decidable here. ExecPlan 197 parked this too.+    fanoutFunctionName =+      [ mkSurfaceRefusal languageContract dl PgmqFanoutFunctionInvalid $+          "dispatch '"+            <> (.name) d+            <> "' fanout body '"+            <> (.fanoutBody) d+            <> "' cannot name a Haskell function; it must be a lowercase-initial identifier that is not a reserved word"+      | not (lowerIdentifierSafe ((.fanoutBody) d))+      ]+    workqueues = [w | NWorkqueue w <- (.nodes) spec]+    enqueueRef =+      [ mkErr dl DispatchEnqueueUnresolved ("dispatch '" <> (.name) d <> "' enqueues to undeclared workqueue '" <> (.enqueueTo) d <> "'")+      | (.enqueueTo) d `notElem` map (.name) workqueues+      ]+    dedupQueueRef = case [w | w <- workqueues, (.name) w == (.dedupQueue) d] of+      [] ->+        [ mkErr dl DispatchDedupQueueUnresolved $+            "dispatch '" <> (.name) d <> "' checks an undeclared dedup queue '" <> (.dedupQueue) d <> "'"+        ]+      (queue : _) ->+        [ mkErr dl DispatchDedupFieldUnresolved $+            "dispatch '" <> (.name) d <> "' dedup field '" <> (.dedupQueueField) d <> "' is not a payload wire field of queue '" <> (.dedupQueue) d <> "'"+        | (.dedupQueueField) d `notElem` map (.wire) ((.payload) queue)+        ]+    sourceReadModelRef =+      resolveReadModelRef DispatchReadModelUnresolved spec ((.loc) d) ("dispatch '" <> (.name) d <> "' source") ((.sourceReadModel) d)+    sourceReadModelField = case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.sourceReadModel) d] of+      [] -> []+      readModel : _ ->+        [ mkErr dl DispatchReadModelFieldUnknown $+            "dispatch '" <> (.name) d <> "' source key '" <> (.sourceKey) d <> "' is not a generated logical selector for a column of readmodel '" <> (.sourceReadModel) d <> "'"+        | enforcesSpecSurfaceClosures languageContract,+          (.sourceKey) d `notElem` map (logicalFieldSelector . (.rmcName)) ((.columns) readModel)+        ]+    dedupReadModelRef =+      resolveReadModelRef DispatchReadModelUnresolved spec ((.loc) d) ("dispatch '" <> (.name) d <> "' dedup") ((.dedupReadModel) d)+    dedupReadModelField = case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.dedupReadModel) d] of+      [] -> []+      (readModel : _) ->+        [ mkErr dl DispatchReadModelFieldUnknown $+            "dispatch '" <> (.name) d <> "' dedup field '" <> (.dedupReadModelField) d <> "' is not a declared column of readmodel '" <> (.dedupReadModel) d <> "'"+        | (.dedupReadModelField) d `notElem` map (.rmcName) ((.columns) readModel)+        ]++-- | The declared contracts in a spec, by name.+specContracts :: Spec -> [ContractNode]+specContracts spec = [c | NContract c <- (.nodes) spec]++-- | EP-4 cross-node coupling: an intake's contract/topic/accepted-events resolve.+intakeCoupling :: EffectiveLanguageContract -> Spec -> IntakeNode -> [Diagnostic]+intakeCoupling languageContract spec i = bindFlagWarnings ++ bindHeaderNames ++ contractCoupling+  where+    -- The Kafka inbox reconstructs an envelope from the canonical header names+    -- in "Keiro.Integration.Event"; nothing reads a spec-declared header. A row+    -- naming a canonical header is descriptive and true, so it stays silent. A+    -- row naming any other header reads like remapping and silently is not.+    bindHeaderNames =+      [ mkSurfaceRefusal languageContract (locLine ((.loc) i)) IntakeBindHeaderUnknown $+          "intake '"+            <> (.name) i+            <> "' binds '"+            <> (.field) binding+            <> "' from header "+            <> T.pack (show headerName)+            <> ", which is not one of keiro's canonical envelope headers; the Kafka inbox reads a fixed header set and cannot be remapped, so this row would not take effect. Use one of: "+            <> T.intercalate ", " (map (T.pack . show) canonicalEnvelopeHeaders)+      | binding <- (.binds) i,+        SrcHeader headerName <- [(.source) binding],+        headerName `notElem` canonicalEnvelopeHeaders+      ]+    contractCoupling = case lookupContract ((.contract) i) of+      Nothing ->+        [mkErr (locLine ((.loc) i)) IntakeUnresolvedContract ("intake '" <> (.name) i <> "' references undeclared contract '" <> (.contract) i <> "'")]+      Just c ->+        concat+          [ [ mkErr (locLine ((.loc) i)) IntakeUnresolvedContract ("intake '" <> (.name) i <> "' topic '" <> (.topic) i <> "' is not a topic of contract '" <> (.contract) i <> "'")+            | (.topic) i `notElem` map fst ((.topics) c)+            ],+            [ mkErr (locLine ((.loc) i)) IntakeUnresolvedContract ("intake '" <> (.name) i <> "' accepts event '" <> ev <> "' not declared in contract '" <> (.contract) i <> "'")+            | ev <- (.accept) i,+              ev `notElem` map (.name) ((.events) c)+            ],+            [ mkErr (locLine ((.loc) i)) TopicAffinityMismatch $+                "intake '" <> (.name) i <> "' subscribes to topic '" <> (.topic) i <> "' but accepted event '" <> (.name) event <> "' is declared on topic '" <> (.topic) event <> "'"+            | event <- (.events) c,+              (.name) event `elem` (.accept) i,+              (.topic) event /= (.topic) i+            ],+            [ mkErr (locLine ((.loc) i)) IntakeBindUnresolved $+                "intake '" <> (.name) i <> "' binds undeclared envelope or accepted-event field '" <> (.field) binding <> "'"+            | enforcesSpecSurfaceClosures languageContract,+              binding <- (.binds) i,+              (.field) binding `Set.notMember` resolvableFields c+            ],+            [ mkErr (locLine ((.loc) i)) IntakeDedupeKeyUnresolved $+                "intake '" <> (.name) i <> "' dedupe key '" <> (.dedupeKey) i <> "' is not an envelope or accepted-event field"+            | enforcesSpecSurfaceClosures languageContract,+              (.dedupeKey) i `Set.notMember` resolvableFields c+            ],+            [ mkErr (locLine ((.loc) i)) IntakeDecodeSchemaVersionMismatch $+                "intake '"+                  <> (.name) i+                  <> "' decode schemaVersion "+                  <> tInt ((.bodySchemaVersion) ((.decode) i))+                  <> " does not match contract '"+                  <> (.name) c+                  <> "' schemaVersion "+                  <> tInt ((.schemaVersion) c)+            | enforcesSpecSurfaceClosures languageContract,+              (.bodySchemaVersion) ((.decode) i) /= (.schemaVersion) c+            ]+          ]+    bindFlagWarnings =+      [ Diagnostic+          { line = locLine ((.loc) i),+            severity = Warning,+            code = IntakeBindFlagUnenforced,+            relatedLocations = [],+            message =+              "intake '"+                <> (.name) i+                <> "' bind for '"+                <> (.field) binding+                <> "' declares "+                <> bindFlagText binding+                <> ", but generated code does not consume envelope bindings"+          }+      | binding <- (.binds) i,+        (.required) binding || (.crossCheck) binding+      ]+    lookupContract n = case [c | c <- specContracts spec, (.name) c == n] of (c : _) -> Just c; [] -> Nothing+    resolvableFields contract =+      canonicalIntakeEnvelopeFields+        <> Set.fromList+          [ (.name) field+          | event <- (.events) contract,+            (.name) event `elem` (.accept) i,+            field <- (.fields) event+          ]+    bindFlagText binding = case ((.required) binding, (.crossCheck) binding) of+      (True, True) -> "'required' and 'cross-check body' flags"+      (True, False) -> "a 'required' flag"+      (False, True) -> "a 'cross-check body' flag"+      (False, False) -> "no enforcement flags"++-- Note: @derive … hole@ is mandatory emit grammar, so a per-emit warning about+-- it would fire on every emit node in every spec and carry no information. The+-- fact that an emit generates no module is reported once, per scaffold run, by+-- the report's inert-node line. See ExecPlan 199.+validateEmit :: EffectiveLanguageContract -> Spec -> EmitNode -> [Diagnostic]+validateEmit languageContract spec e = skipRule ++ duplicateCases ++ coupling+  where+    el = locLine ((.loc) e)+    skipRule =+      [ mkErr el EmitSkipMissing ("emit '" <> (.name) e <> "' map must end with an explicit '_ => skip' catch-all (hole-kind 7 optionality)")+      | not ((.skip) e)+      ]+    duplicateCases =+      [ mkErr (locLine ((.loc) row)) EmitMapDuplicateCase $+          "emit '" <> (.name) e <> "' repeats map discriminant '" <> (.value) row <> "'; the first row would shadow this row"+      | enforcesSpecSurfaceClosures languageContract,+        row <- duplicatesBy (.value) ((.map) e)+      ]+    coupling = case [c | c <- specContracts spec, (.name) c == (.contract) e] of+      [] -> [mkErr el EmitUnresolvedContract ("emit '" <> (.name) e <> "' references undeclared contract '" <> (.contract) e <> "'")]+      (c : _) ->+        [ mkErr el EmitUnresolvedContract ("emit '" <> (.name) e <> "' topic '" <> (.topic) e <> "' is not a topic of contract '" <> (.contract) e <> "'")+        | (.topic) e `notElem` map fst ((.topics) c)+        ]+          ++ [ mkErr (locLine ((.loc) r)) EmitUnresolvedContract ("emit '" <> (.name) e <> "' maps to event '" <> (.event) r <> "' not declared in contract '" <> (.contract) e <> "'")+             | r <- (.map) e,+               (.event) r `notElem` map (.name) ((.events) c)+             ]+          ++ [ mkErr (locLine ((.loc) row)) TopicAffinityMismatch $+                 "emit '" <> (.name) e <> "' publishes on topic '" <> (.topic) e <> "' but mapped event '" <> (.event) row <> "' is declared on topic '" <> (.topic) event <> "'"+             | row <- (.map) e,+               event <- (.events) c,+               (.name) event == (.event) row,+               (.topic) event /= (.topic) e+             ]++validatePublisher :: EffectiveLanguageContract -> Spec -> PublisherNode -> [Diagnostic]+validatePublisher languageContract spec p =+  unresolvedEmit ++ orderingVocabulary ++ backoffPolicy ++ attemptsFloor ++ outboxField ++ windows+  where+    publisherLine = locLine ((.loc) p)+    unresolvedEmit =+      [ mkErr publisherLine PublisherUnresolvedEmit ("publisher '" <> (.name) p <> "' references undeclared emit '" <> (.emit) p <> "'")+      | (.emit) p `notElem` [(.name) e | NEmit e <- (.nodes) spec]+      ]+    orderingVocabulary =+      [ mkErr publisherLine PublisherOrderingUnknown $+          "publisher '"+            <> (.name) p+            <> "' has unknown ordering '"+            <> (.ordering) p+            <> "'; expected PerKeyHeadOfLine, PerSourceStream, StopTheLine, or BestEffort"+      | (.ordering) p `Set.notMember` publisherOrderings+      ]+    backoffPolicy =+      [ mkErr publisherLine PublisherBackoffInvalid $+          "publisher '" <> (.name) p <> "' has an invalid " <> problem+      | Just problem <- [backoffProblemMaybe ((.backoff) p)]+      ]+    attemptsFloor =+      [ mkErr publisherLine PublisherMaxAttemptsBelowMinimum $+          "publisher '" <> (.name) p <> "' maxAttempts must be at least 1"+      | enforcesSpecSurfaceClosures languageContract,+        (.maxAttempts) p < 1+      ]+    outboxField = case [emitNode | NEmit emitNode <- (.nodes) spec, (.name) emitNode == (.emit) p] of+      [] -> []+      emitNode : _ ->+        [ mkErr publisherLine PublisherOutboxFieldUnresolved $+            "publisher '" <> (.name) p <> "' outboxId field '" <> (.outboxField) p <> "' is not messageId, idempotencyKey, or a field of an event mapped by emit '" <> (.emit) p <> "'"+        | enforcesSpecSurfaceClosures languageContract,+          (.outboxField) p `Set.notMember` allowedOutboxFields emitNode+        ]+    allowedOutboxFields emitNode =+      Set.fromList ("messageId" : "idempotencyKey" : mappedContractFields emitNode)+    mappedContractFields emitNode =+      [ (.dslName) (resolveContractFieldIdentity field)+      | contract <- specContracts spec,+        (.name) contract == (.contract) emitNode,+        event <- (.events) contract,+        (.name) event `elem` map (.event) ((.map) emitNode),+        field <- (.fields) event+      ]+    windows =+      windowRangeRule languageContract publisherLine ("publisher '" <> (.name) p <> "' backoff") ((.window) ((.backoff) p))+        ++ maybe [] (windowRangeRule languageContract publisherLine ("publisher '" <> (.name) p <> "' maximum backoff")) ((.max) ((.backoff) p))++publisherOrderings :: Set Name+publisherOrderings = Set.fromList ["PerKeyHeadOfLine", "PerSourceStream", "StopTheLine", "BestEffort"]++backoffProblemMaybe :: BackoffSpec -> Maybe Text+backoffProblemMaybe backoff = case (.kind) backoff of+  "constant" -> Nothing+  "exponential" -> case ((.max) backoff, (.multiplier) backoff) of+    (Just maximumWindow, Just multiplierText) ->+      case (validationWindowSeconds ((.window) backoff), validationWindowSeconds maximumWindow, readMaybe (T.unpack multiplierText) :: Maybe Double) of+        (Just initialSeconds, Just maximumSeconds, Just multiplier)+          | initialSeconds > 0 && maximumSeconds >= initialSeconds && multiplier >= 1 -> Nothing+        _ -> Just "exponential backoff; initial must be positive, max must be at least initial, and multiplier must be at least 1"+    _ -> Just "exponential backoff; both max and multiplier are required"+  other -> Just ("backoff kind '" <> other <> "'; expected constant or exponential")++validationWindowSeconds :: Text -> Maybe Int+validationWindowSeconds window = case T.unsnoc window of+  Just (digits, unit) -> do+    amount <- readMaybe (T.unpack digits)+    case unit of+      's' -> Just amount+      'm' -> Just (amount * 60)+      'h' -> Just (amount * 3600)+      _ -> Nothing+  Nothing -> Nothing++windowSecondsBounded :: Text -> Either Text Int+windowSecondsBounded window = case T.unsnoc window of+  Nothing -> Left "has no unit"+  Just (digits, unit) -> case readMaybe (T.unpack digits) :: Maybe Integer of+    Nothing -> Left "has invalid digits"+    Just amount -> case unitFactor unit of+      Nothing -> Left "has an unknown unit"+      Just factor+        | seconds > fromIntegral (maxBound :: Int) -> Left "exceeds the runtime Int seconds range"+        | otherwise -> Right (fromIntegral seconds)+        where+          seconds = amount * factor+  where+    unitFactor 's' = Just 1+    unitFactor 'm' = Just 60+    unitFactor 'h' = Just 3600+    unitFactor _ = Nothing++windowRangeRule :: EffectiveLanguageContract -> Int -> Text -> Text -> [Diagnostic]+windowRangeRule languageContract diagnosticLine context window =+  [ mkErr diagnosticLine WindowOutOfRange $+      context <> " window '" <> window <> "' " <> reason+  | enforcesSpecSurfaceClosures languageContract,+    Left reason <- [windowSecondsBounded window]+  ]++-- | EP-4 inbox disposition rules: the table must be complete over the seven+-- outcomes, and the three dangerous inversions must be stated the safe way.+validateIntake :: EffectiveLanguageContract -> IntakeNode -> [Diagnostic]+validateIntake languageContract i = concat [completeness, duplicateRows, inversions, dedupeVocabulary, decodeVersionFloor, envelopeVocabulary, decodePosture, windows]+  where+    il = locLine ((.loc) i)+    -- `decBodyStrict` reaches nothing but the pretty-printer: generated contract+    -- codecs decode every declared body field as required and admit no lenient+    -- mode, so `body strict` describes what happens and `body lenient` does not.+    decodePosture =+      [ mkSurfaceRefusal languageContract il DecodeBodyPostureUnsupported $+          "intake '"+            <> (.name) i+            <> "' declares 'body lenient', but generated contract codecs decode a body strictly: every declared field is required and no lenient fallback is emitted. Write 'body strict' to describe what runs"+      | not ((.bodyStrict) ((.decode) i))+      ]+    rows = (.disposition) i+    requiredOutcomes =+      ["processed", "duplicate", "inProgress", "previouslyFailed", "decodeFailed", "dedupeFailed", "storeFailed"]+    completeness =+      [ mkErr il DispositionIncomplete $+          "intake '" <> (.name) i <> "' disposition table is missing outcome '" <> o <> "'"+      | o <- requiredOutcomes,+        o `notElem` map (.outcome) rows+      ]+    duplicateRows =+      [ mkErr (locLine ((.loc) row)) DispositionDuplicateOutcome $+          "intake '" <> (.name) i <> "' repeats disposition outcome '" <> (.outcome) row <> "'; the first row would shadow this row"+      | row <- duplicatesBy (.outcome) rows+      ]+    windows =+      concat+        [ windowRangeRule languageContract (locLine ((.loc) row)) ("intake '" <> (.name) i <> "' retry") window+        | row <- rows,+          IRetry window <- [(.action) row]+        ]+    dedupeVocabulary =+      [ mkErr il IntakeDedupePolicyUnknown $+          "intake '"+            <> (.name) i+            <> "' has unknown dedupe policy '"+            <> (.dedupePolicy) i+            <> "'; expected PreferIntegrationMessageId, PreferSourceEventIdentity, or KafkaDeliveryIdentity"+      | (.dedupePolicy) i `Set.notMember` intakeDedupePolicies+      ]+    decodeVersionFloor =+      [ mkErr il IntakeDecodeSchemaVersionBelowMinimum $+          "intake '" <> (.name) i <> "' decode schemaVersion must be at least 1"+      | enforcesSpecSurfaceClosures languageContract,+        (.bodySchemaVersion) ((.decode) i) < 1+      ]+    envelopeVocabulary =+      [ mkErr il IntakeEnvelopePolicyUnknown $+          "intake '" <> (.name) i <> "' has unsupported envelope policy " <> T.pack (show ((.envelope) ((.decode) i))) <> "; expected \"strict-required lenient-optional\""+      | enforcesSpecSurfaceClosures languageContract,+        (.envelope) ((.decode) i) /= "strict-required lenient-optional"+      ]+    firstRow outcome = case [row | row <- rows, (.outcome) row == outcome] of+      (row : _) -> Just row+      [] -> Nothing+    isRetry row = case (.action) row of IRetry _ -> True; _ -> False+    inversions =+      [ mkErr (locLine ((.loc) row)) DispositionDuplicateRetry $+          "intake '" <> (.name) i <> "': a 'duplicate' redelivery must be ackOk (success), not retry"+      | Just row <- [firstRow "duplicate"],+        isRetry row+      ]+        ++ [ mkErr (locLine ((.loc) row)) DispositionPreviouslyFailedRetry $+               "intake '" <> (.name) i <> "': 'previouslyFailed' must dead-letter, not retry (a prior failure won't succeed on replay)"+           | Just row <- [firstRow "previouslyFailed"],+             isRetry row+           ]+        ++ [ mkErr (locLine ((.loc) row)) DispositionDecodeUnboundedRetry $+               "intake '" <> (.name) i <> "': 'decodeFailed' must dead-letter (terminal), not retry unboundedly"+           | Just row <- [firstRow "decodeFailed"],+             isRetry row+           ]++intakeDedupePolicies :: Set Name+intakeDedupePolicies = Set.fromList ["PreferIntegrationMessageId", "PreferSourceEventIdentity", "KafkaDeliveryIdentity"]++-- | The timer statuses a stored row can hold, mirroring @TimerStatus@ in+-- @keiro@'s "Keiro.Timer.Schema". keiro-dsl deliberately does not depend on the+-- runtime package, so the list is restated here; the conformance suite that does+-- depend on @keiro@ asserts the two agree.+runtimeTimerStatuses :: [Text]+runtimeTimerStatuses = ["Scheduled", "Firing", "Fired", "Cancelled", "Dead"]++-- | Every header name keiro's integration envelope actually uses on the wire,+-- taken from the runtime's own definitions in "Keiro.Integration.Event" rather+-- than restated here, so the two cannot drift apart.+canonicalEnvelopeHeaders :: [Text]+canonicalEnvelopeHeaders =+  [ Event.headerMessageId,+    Event.headerSource,+    Event.headerDestination,+    Event.headerEventType,+    Event.headerSchemaVersion,+    Event.headerContentType,+    Event.headerSchemaRegistry,+    Event.headerSchemaSubject,+    Event.headerSchemaVersionRef,+    Event.headerSchemaId,+    Event.headerSchemaFingerprint,+    Event.headerSourceEventId,+    Event.headerSourceGlobalPosition,+    Event.headerCausationId,+    Event.headerCorrelationId,+    Event.headerTraceParent,+    Event.headerTraceState,+    Event.headerOccurredAt,+    Event.headerAttributes+  ]++canonicalIntakeEnvelopeFields :: Set Name+canonicalIntakeEnvelopeFields =+  Set.fromList+    [ "messageId",+      "source",+      "destination",+      "key",+      "eventType",+      "schemaVersion",+      "contentType",+      "schemaReference",+      "sourceEventId",+      "sourceGlobalPosition",+      "payloadBytes",+      "occurredAt",+      "causationId",+      "correlationId",+      "traceContext",+      "attributes",+      "idempotencyKey"+    ]++-- | EP-3 rules for a process manager + its nested timer.+validateProcess :: EffectiveLanguageContract -> Spec -> ProcessNode -> [Diagnostic]+validateProcess languageContract spec p =+  concat [sagaCategoryRule, noWallClock, runtimeOwnedDispatchId, crossNodeCoupling, strictSurfaceResolution, timerCeiling, policyRules, ambiguityRule, benignInversions, onAppendedArms, notMineArm, decodeUnknownStatus, deadLetterText]+  where+    -- Generated dispatch code appends and then acks; `Keiro.ProcessManager` has+    -- no branch that retries or dead-letters a *successful* append. Only AckOk+    -- describes what runs.+    onAppendedArms =+      [ mkSurfaceRefusal languageContract (locLine ((.loc) d)) DispatchOnAppendedUnsupported $+          "dispatch to '"+            <> (.target) d+            <> "' maps on-appended => "+            <> dispText ((.onAppended) ((.disposition) d))+            <> ", but a successful append is always acked: no runtime path retries or dead-letters an event it just appended. Write 'on-appended AckOk'"+      | d <- (.dispatch) ((.handle) p),+        (.onAppended) ((.disposition) d) /= DAckOk+      ]++    -- `decode unknown-status => X` names the status a row that fails to decode+    -- is read as. X must be a status the timer table actually has.+    decodeUnknownStatus =+      [ mkSurfaceRefusal languageContract (locLine ((.loc) timer)) TimerDecodeStatusUnknown $+          "timer '"+            <> (.name) timer+            <> "' maps decode unknown-status => '"+            <> (.decodeUnknown) timer+            <> "', which is not a timer status; a stored timer row is one of: "+            <> T.intercalate ", " runtimeTimerStatuses+      | (.decodeUnknown) timer `notElem` runtimeTimerStatuses+      ]++    -- The dead-letter reason is a hand-owned obligation: `runTimerWorkerWith`+    -- composes its own message for the attempt ceiling, and the generated+    -- comment surfaces this text so an operator-written worker can pass it to+    -- `Keiro.Timer.deadLetterTimer`. Nothing can check what the prose says, but+    -- an empty or blank reason names no obligation at all.+    deadLetterText =+      [ mkSurfaceRefusal languageContract (locLine ((.loc) timer)) TimerDeadLetterTextInvalid $+          "timer '"+            <> (.name) timer+            <> "' declares a blank dead-letter reason; the reason is the hand-owned text an operator-written timer worker passes to Keiro.Timer.deadLetterTimer, so it must say something"+      | T.null (T.strip ((.deadLetter) timer))+      ]++    -- The timer worker marks a timer Fired only when the fire action returns the+    -- id of an event it appended (`Keiro.Timer.runTimerWorkerWith`). A not-mine+    -- dispatch produces no such id, so the row is left Firing and requeued on a+    -- later pass — which is exactly Retry. Fired is not reachable.+    notMineArm =+      [ mkSurfaceRefusal languageContract (locLine ((.loc) timer)) TimerNotMineUnsupported $+          "timer '"+            <> (.name) timer+            <> "' maps not-mine => Fired, but the timer worker marks a timer Fired only when the fire action returns the id of the event it appended; a dispatch that is not this timer's has no such id, so the row is requeued instead. Write 'not-mine Retry'"+      | (.notMine) ((.disposition) ((.fire) timer)) == OFired+      ]+    aggregates = [a | NAggregate a <- (.nodes) spec]+    aggNames = map (.name) aggregates+    projectionTables = [(.table) projection | aggregate <- aggregates, Just projection <- [(.projection) aggregate]]+    inputFields = map (.name) ((.fields) ((.input) p))+    timeFields = [(.name) f | f <- (.fields) ((.input) p), (.valueType) f == Just "Time"]+    timer = (.timer) p+    pl = locLine ((.loc) p)++    sagaCategoryRule =+      [ mkErr pl SagaCategoryIllegal $+          "saga category " <> T.pack (show ((.category) ((.saga) p))) <> " " <> reason+      | Just reason <- [sagaCategoryError ((.category) ((.saga) p))]+      ]++    -- TIME IS INJECTED, NOT SAMPLED: fireAt's field must be a declared :Time+    -- input field. (FireAtExpr has no clock-sampling constructor, so this is a+    -- field-resolution + typed-as-Time check.)+    noWallClock =+      let f = (.field) ((.fireAt) timer)+       in if f `notElem` inputFields+            then+              [ mkErr (locLine ((.loc) timer)) ProcessFireAtNotInjected $+                  "timer '" <> (.name) timer <> "' fireAt field '" <> f <> "' is not a field of input '" <> (.name) ((.input) p) <> "'"+              ]+            else+              [ mkErr (locLine ((.loc) timer)) ProcessFireAtNotInjected $+                  "timer '" <> (.name) timer <> "' fireAt references '" <> f <> "', which is not a declared :Time field of input '" <> (.name) ((.input) p) <> "'"+              | f `notElem` timeFields+              ]++    -- Dispatched (and fired) command ids are runtime-owned; no field binding may+    -- supply a commandId/id.+    runtimeOwnedDispatchId =+      [ mkErr pl ProcessDispatchIdSupplied $+          "advance command '" <> (.advCommand) advance <> "' supplies a runtime-owned id field '" <> (.name) binding <> "'; remove it"+      | let advance = (.advance) ((.handle) p),+        binding <- (.advFields) advance,+        (.name) binding `elem` (["commandId", "id"] :: [Name])+      ]+        ++ [ mkErr (locLine ((.loc) d)) ProcessDispatchIdSupplied $+               "dispatch to '" <> (.target) d <> "' supplies a runtime-owned id field '" <> (.name) b <> "'; remove it"+           | d <- (.dispatch) ((.handle) p),+             b <- (.fields) d,+             (.name) b `elem` (["commandId", "id"] :: [Name])+           ]+        ++ [ mkErr (locLine ((.loc) timer)) ProcessDispatchIdSupplied $+               "timer fire supplies a runtime-owned id field '" <> (.name) b <> "'; remove it"+           | b <- (.fields) ((.fire) timer),+             (.name) b `elem` (["commandId", "id"] :: [Name])+           ]++    -- Aggregate, command, field, timer, and projection references must resolve.+    crossNodeCoupling =+      [ mkErr pl ProcessUnresolvedRef ("saga '" <> (.agg) ((.saga) p) <> "' does not resolve to a declared aggregate")+      | (.agg) ((.saga) p) `notElem` aggNames+      ]+        ++ [ mkErr pl ProcessUnresolvedRef ("target '" <> (.target) p <> "' does not resolve to a declared aggregate")+           | (.target) p `notElem` aggNames+           ]+        ++ [ mkErr (locLine ((.loc) timer)) ProcessUnresolvedRef ("timer fire target '" <> (.target) ((.fire) timer) <> "' must be the saga or the target aggregate")+           | (.target) ((.fire) timer) `notElem` [(.agg) ((.saga) p), (.target) p]+           ]+        ++ resolveCommand pl "advance" ((.agg) ((.saga) p)) ((.advCommand) advance) ((.advFields) advance)+        ++ concatMap resolveDispatch ((.dispatch) ((.handle) p))+        ++ resolveCommand (locLine ((.loc) timer)) "timer fire" ((.target) fire) ((.command) fire) ((.fields) fire)+        ++ [ mkErr pl ProcessUnresolvedRef $+               "process '" <> (.id) p <> "' schedules undeclared timer '" <> (.schedule) ((.handle) p) <> "'; declared timer is '" <> (.name) timer <> "'"+           | (.schedule) ((.handle) p) /= (.name) timer+           ]+        ++ [ mkErr pl ProcessUnresolvedRef $+               "process '" <> (.id) p <> "' references undeclared projection table '" <> projection <> "'"+           | projection <- (.projections) p,+             projection `notElem` projectionTables+           ]+      where+        advance = (.advance) ((.handle) p)+        fire = (.fire) timer+        resolveDispatch dispatch =+          resolveCommand+            (locLine ((.loc) dispatch))+            "dispatch"+            ((.target) dispatch)+            ((.command) dispatch)+            ((.fields) dispatch)+        resolveCommand diagnosticLine context target command bindings = case lookupAggregate target of+          Nothing -> []+          Just aggregate -> case [decl | decl <- (.commands) aggregate, (.name) decl == command] of+            [] ->+              [ mkErr diagnosticLine ProcessUnresolvedRef $+                  context <> " command '" <> command <> "' is not declared by aggregate '" <> target <> "'"+              ]+            (declaration : _) ->+              [ mkErr diagnosticLine ProcessFieldBindingUnresolved $+                  context <> " command '" <> command <> "' binds undeclared target field '" <> (.name) binding <> "'"+              | binding <- bindings,+                (.name) binding `notElem` map (.name) ((.fields) declaration)+              ]+        lookupAggregate name = case [aggregate | aggregate <- aggregates, (.name) aggregate == name] of+          (aggregate : _) -> Just aggregate+          [] -> Nothing++    strictSurfaceResolution+      | not (enforcesSpecSurfaceClosures languageContract) = []+      | otherwise = correlateFieldRule ++ dispatchKeyRules ++ bindingScopeRules ++ idFieldRules ++ fireWindowRule++    correlateFieldRule =+      [ mkErr pl ProcessKeyFieldUnknown $+          "correlate references 'input." <> (.field) ((.correlate) p) <> "' but input '" <> (.name) ((.input) p) <> "' does not declare that field"+      | (.field) ((.correlate) p) `notElem` inputFields+      ]++    dispatchKeyRules =+      [ mkErr (locLine ((.loc) dispatch)) ProcessDispatchKeyUnresolved $+          "dispatch to '" <> (.target) dispatch <> "' uses unresolved key '" <> (.key) dispatch <> "'; expected correlationId or input.<declared-field>"+      | dispatch <- (.dispatch) ((.handle) p),+        not (processKeyInScope ((.key) dispatch))+      ]+        ++ [ mkErr (locLine ((.loc) timer)) ProcessDispatchKeyUnresolved $+               "timer fire to '" <> (.target) ((.fire) timer) <> "' uses unresolved key '" <> (.key) ((.fire) timer) <> "'; expected correlationId or input.<declared-field>"+           | not (processKeyInScope ((.key) ((.fire) timer)))+           ]++    processKeyInScope value =+      value == "correlationId"+        || case T.stripPrefix "input." value of+          Just field -> field `elem` inputFields+          Nothing -> False++    bindingScopeRules =+      bindingRules pl "advance" inputFields ((.advFields) ((.advance) ((.handle) p)))+        ++ concatMap+          (\dispatch -> bindingRules (locLine ((.loc) dispatch)) "dispatch" inputFields ((.fields) dispatch))+          ((.dispatch) ((.handle) p))+        ++ bindingRules+          (locLine ((.loc) timer))+          "timer fire"+          (inputFields <> map (.name) ((.payload) timer) <> ["timerId"])+          ((.fields) ((.fire) timer))++    bindingRules diagnosticLine context bareScope bindings =+      [ mkErr diagnosticLine ProcessBindingUnscoped $+          context <> " binding '" <> (.name) binding <> maybe "" ("=" <>) ((.value) binding) <> "' is outside the process input and timer scopes"+      | binding <- bindings,+        not (bindingInScope bareScope binding)+      ]++    bindingInScope bareScope binding = case (.value) binding of+      Nothing -> (.name) binding `elem` bareScope+      Just value+        | isQuoted value -> True+        | value == "timer.id" -> True+        | Just field <- T.stripPrefix "input." value -> field `elem` inputFields+        | otherwise -> value `elem` bareScope++    isQuoted value = T.length value >= 2 && T.head value == '"' && T.last value == '"'++    idFieldRules =+      [ mkErr (locLine ((.loc) timer)) TimerIdFieldNotCorrelation $+          "timer '" <> (.name) timer <> "' " <> context <> " derives from '" <> (.field) expression <> "'; only correlationId is implemented by generated runtime code"+      | (context, expression) <- [("id", (.id) timer), ("fired-event-id", (.firedEventId) ((.fire) timer))],+        (.field) expression /= "correlationId"+      ]++    fireWindowRule =+      windowRangeRule languageContract (locLine ((.loc) timer)) ("timer '" <> (.name) timer <> "' fireAt") ((.window) ((.fireAt) timer))++    timerCeiling =+      [ mkErr (locLine ((.loc) timer)) ProcessTimerCeilingInvalid $+          "timer '" <> (.name) timer <> "' max-attempts must be at least 1"+      | (.maxAttempts) timer < 1+      ]++    policyRules =+      policyConsistency+        ((.id) p)+        ((.loc) p)+        ((.rejected) p)+        [ ((.command) dispatch, (.loc) dispatch, (.disposition) dispatch)+        | dispatch <- (.dispatch) ((.handle) p)+        ]++    ambiguityRule =+      [ mkErr (locLine ((.loc) timer)) AmbiguousMarkedBenign $+          "timer '" <> (.name) timer <> "' maps on-ambiguous => Fired; CommandAmbiguous means multiple aggregate edges matched and is never a benign success. Use on-ambiguous Retry so the attempts ceiling dead-letters the definition bug"+      | (.onAmbiguous) ((.disposition) ((.fire) timer)) == OFired+      ]++    -- Surface the dangerous benign inversions the author confirmed (warnings).+    benignInversions =+      [ Diagnostic (locLine ((.loc) timer)) Warning ProcessBenignInversion [] $+          "timer '" <> (.name) timer <> "' maps on-reject => Fired (a CommandRejected is treated as benign success)"+      | (.onReject) ((.disposition) ((.fire) timer)) == OFired+      ]+        ++ [ Diagnostic (locLine ((.loc) d)) Warning ProcessBenignInversion [] $+               "dispatch to '" <> (.target) d <> "' maps on-duplicate => AckOk (a duplicate is treated as benign success)"+           | d <- (.dispatch) ((.handle) p),+             (.onDuplicate) ((.disposition) d) == DAckOk+           ]++-- | Explain why a process saga category is illegal.  The first four cases+-- mirror 'Keiro.Stream.category' without introducing a runtime dependency into+-- the toolchain library.  The final @:@ case is deliberately stricter because+-- that prefix is reserved for the @wf:<name>@ workflow stream family.+sagaCategoryError :: Text -> Maybe Text+sagaCategoryError = runtimeIdentityError False++stableIdentityError :: Text -> Maybe Text+stableIdentityError = runtimeIdentityError True++runtimeIdentityError :: Bool -> Text -> Maybe Text+runtimeIdentityError allowsHyphen identity+  | T.null identity = Just "is empty; use a non-empty stable name"+  | identity == "$all" = Just "is reserved by the event store; choose a service-owned stable name"+  | not allowsHyphen && T.isInfixOf "-" identity = Just "contains '-' (kiroku's category/id boundary); write compound categories in camelCase, for example \"hospitalSurge\""+  | Just illegal <- T.find (\character -> isSpace character || isControl character) identity =+      Just ("contains whitespace or control character " <> T.pack (show illegal) <> "; remove it and use camelCase")+  | T.isInfixOf ":" identity = Just "contains ':' which is reserved for runtime stream-family prefixes; choose a stable name without ':'"+  | otherwise = Nothing++-- | The generated lower-camel selector for a logical field or SQL column.+-- Read-model notation stores SQL names such as @responder_id@ while router+-- resolve rows and dispatch keys use the generated selector @responderId@.+logicalFieldSelector :: Text -> Text+logicalFieldSelector raw =+  case HaskellName.deriveHaskellName HaskellName.LogicalIdentifier site of+    Right derived -> HaskellName.renderLowerCamelName ((.lowerCamel) derived)+    Left _ -> raw+  where+    site =+      HaskellName.NameSite+        { HaskellName.kind = HaskellName.GeneratedFieldSite,+          HaskellName.logicalName = raw,+          HaskellName.owner = "validation field resolution",+          HaskellName.line = 0+        }++-- | EP-108 rules for a stateless content-based router.+validateRouter :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> RouterNode -> [Diagnostic]+validateRouter languageContract typeGraphResult spec router =+  concat+    [ references,+      keyField,+      bindingScope,+      commandReference,+      readModelReference,+      selectionChecks,+      policyRules,+      duplicateNotice,+      onAppendedArm+    ]+  where+    -- The process twin of this rule is in 'validateProcess'; both say the same+    -- thing because both runtimes do: a successful append is always acked.+    onAppendedArm =+      [ mkSurfaceRefusal languageContract dispatchLine DispatchOnAppendedUnsupported $+          "router dispatch '"+            <> (.command) dispatch+            <> "' maps on-appended => "+            <> dispText ((.onAppended) ((.disposition) dispatch))+            <> ", but a successful append is always acked: no runtime path retries or dead-letters an event it just appended. Write 'on-appended AckOk'"+      | (.onAppended) ((.disposition) dispatch) /= DAckOk+      ]+    aggregates = [aggregate | NAggregate aggregate <- (.nodes) spec]+    readModels = [readModel | NReadModel readModel <- (.nodes) spec]+    inputFields = map (.name) ((.fields) ((.input) router))+    resolvedFields = (.row) ((.resolve) router)+    dispatch = (.dispatch) router+    routerLine = locLine ((.loc) router)+    dispatchLine = locLine ((.loc) dispatch)++    targetAggregate = case [aggregate | aggregate <- aggregates, (.name) aggregate == (.target) router] of+      aggregate : _ -> Just aggregate+      [] -> Nothing++    projectionTables = [(.table) projection | aggregate <- aggregates, Just projection <- [(.projection) aggregate]]++    references =+      [ mkErr routerLine RouterUnresolvedRef $+          "router '" <> (.id) router <> "' targets aggregate '" <> (.target) router <> "' but no such aggregate is declared"+      | targetAggregate == Nothing+      ]+        ++ [ mkErr routerLine RouterUnresolvedRef $+               "router '" <> (.id) router <> "' references undeclared projection table '" <> projection <> "'"+           | projection <- (.projections) router,+             projection `notElem` projectionTables+           ]++    keyField = case (.source) ((.resolve) router) of+      ResolveDeclarative {} -> []+      _ ->+        [ mkErr routerLine RouterKeyFieldUnknown $+            "key references 'input." <> (.field) ((.key) router) <> "' but input '" <> (.name) ((.input) router) <> "' does not declare that field"+        | (.field) ((.key) router) `notElem` inputFields+        ]++    bindingScope = case (.source) ((.resolve) router) of+      ResolveDeclarative {} -> []+      _ ->+        [ mkErr dispatchLine RouterBindingUnscoped $+            "dispatch binding '" <> (.name) binding <> maybe "" ("=" <>) ((.value) binding) <> "' is outside the router input and resolve-row scopes"+        | binding <- (.fields) dispatch,+          not (bindingInScope binding)+        ]+      where+        bindingInScope binding = case (.value) binding of+          Nothing -> (.name) binding `elem` inputFields+          Just value+            | isQuoted value -> True+            | Just field <- T.stripPrefix "input." value -> field `elem` inputFields+            | Just field <- T.stripPrefix "resolved." value -> field `elem` resolvedFields+            | otherwise -> False+        isQuoted value = T.length value >= 2 && T.head value == '"' && T.last value == '"'++    commandReference = case targetAggregate of+      Nothing -> []+      Just aggregate -> case [command | command <- (.commands) aggregate, (.name) command == (.command) dispatch] of+        [] ->+          [ mkErr dispatchLine RouterCommandUnknown $+              "dispatch command '" <> (.command) dispatch <> "' is not declared by aggregate '" <> (.name) aggregate <> "'"+          ]+        command : _ ->+          [ mkErr dispatchLine RouterCommandUnknown $+              "dispatch command '" <> (.command) dispatch <> "' binds undeclared target field '" <> (.name) binding <> "'"+          | binding <- (.fields) dispatch,+            (.name) binding `notElem` map (.name) ((.fields) command)+          ]++    readModelReference = case (.source) ((.resolve) router) of+      ResolveHole -> []+      ResolveDeclarative {} -> []+      ResolveReadModel name ->+        case [readModel | readModel <- readModels, (.name) readModel == name] of+          [] ->+            [ mkErr (locLine ((.loc) ((.resolve) router))) RouterUnresolvedRef $+                "router '" <> (.id) router <> "' resolve names readmodel '" <> name <> "' but no such readmodel node is declared"+            ]+          readModel : _ ->+            [ mkErr (locLine ((.loc) ((.resolve) router))) RouterReadModelUnverified $+                "router '" <> (.id) router <> "' resolve row field '" <> column <> "' is not a declared column of readmodel '" <> name <> "'"+            | enforcesSpecSurfaceClosures languageContract,+              column <- (.row) ((.resolve) router),+              column `notElem` map (logicalFieldSelector . (.rmcName)) ((.columns) readModel)+            ]++    selectionChecks = case (.source) ((.resolve) router) of+      ResolveDeclarative {} -> case typeGraphResult of+        Left _ -> []+        Right graph -> case RouterSelection.checkRouterSelection languageContract graph spec router of+          Right _ -> []+          Left diagnostics -> map routerSelectionDiagnostic (NE.toList diagnostics)+      _ -> []++    policyRules =+      policyConsistency+        ((.id) router)+        ((.loc) router)+        ((.rejected) router)+        [((.command) dispatch, (.loc) dispatch, (.disposition) dispatch)]++    duplicateNotice =+      [ Diagnostic dispatchLine Warning RouterBenignInversion [] $+          "router dispatch '" <> (.command) dispatch <> "' maps on-duplicate => AckOk; Keiro.Router confirms the event id against the target stream before treating the duplicate as benign"+      | (.onDuplicate) ((.disposition) dispatch) == DAckOk+      ]++routerSelectionDiagnostic :: RouterSelection.RouterSelectionDiagnostic -> Diagnostic+routerSelectionDiagnostic diagnostic =+  mkErr+    (locLine ((.loc) diagnostic))+    (routerSelectionDiagnosticCode ((.code) diagnostic))+    ((.message) diagnostic)++routerSelectionDiagnosticCode :: RouterSelection.RouterSelectionDiagnosticCode -> DiagnosticCode+routerSelectionDiagnosticCode = \case+  RouterSelection.SelectionNotDeclarative -> RouterSelectionNotDeclarative+  RouterSelection.SelectionCapabilityUnavailable -> RouterSelectionCapabilityUnavailable+  RouterSelection.SelectionIdentityEmpty -> RouterSelectionIdentityEmpty+  RouterSelection.SelectionVersionInvalid -> RouterSelectionVersionInvalid+  RouterSelection.SelectionQueryUnknown -> RouterSelectionQueryUnknown+  RouterSelection.SelectionQueryContractMissing -> RouterSelectionQueryContractMissing+  RouterSelection.SelectionQueryInputBindingInvalid -> RouterSelectionQueryInputBindingInvalid+  RouterSelection.SelectionQueryInputTypeMismatch -> RouterSelectionQueryInputTypeMismatch+  RouterSelection.SelectionQueryResultNotList -> RouterSelectionQueryResultNotList+  RouterSelection.SelectionQueryRowNotStructural -> RouterSelectionQueryRowNotStructural+  RouterSelection.SelectionExpressionRootUnknown -> RouterSelectionExpressionRootUnknown+  RouterSelection.SelectionExpressionFieldUnknown -> RouterSelectionExpressionFieldUnknown+  RouterSelection.SelectionExpressionFieldOptional -> RouterSelectionExpressionFieldOptional+  RouterSelection.SelectionExpressionTypeMismatch -> RouterSelectionExpressionTypeMismatch+  RouterSelection.SelectionPredicateNotBool -> RouterSelectionPredicateNotBool+  RouterSelection.SelectionRecipientNotText -> RouterSelectionRecipientNotText+  RouterSelection.SelectionOperatorUnsupported -> RouterSelectionOperatorUnsupported+  RouterSelection.SelectionRecipientLimitMissing -> RouterSelectionRecipientLimitMissing+  RouterSelection.SelectionRecipientLimitInvalid -> RouterSelectionRecipientLimitInvalid+  RouterSelection.SelectionOrderUnsupported -> RouterSelectionOrderUnsupported+  RouterSelection.SelectionDedupeUnsupported -> RouterSelectionDedupeUnsupported+  RouterSelection.SelectionFailureAckForbidden -> RouterSelectionFailureAckForbidden+  RouterSelection.SelectionRedeliveryUnsupported -> RouterSelectionRedeliveryUnsupported+  RouterSelection.SelectionPartialDispatchUnsupported -> RouterSelectionPartialDispatchUnsupported+  RouterSelection.SelectionTargetAmbiguous -> RouterSelectionTargetAmbiguous+  RouterSelection.SelectionCommandUnknown -> RouterSelectionCommandUnknown+  RouterSelection.SelectionCommandMappingDuplicate -> RouterSelectionCommandMappingDuplicate+  RouterSelection.SelectionCommandMappingIncomplete -> RouterSelectionCommandMappingIncomplete+  RouterSelection.SelectionCommandMappingTypeMismatch -> RouterSelectionCommandMappingTypeMismatch++-- | Reconcile per-dispatch prose with the one node-level policy the runtime+-- actually applies to a rejection-class failure group.+policyConsistency :: Name -> Loc -> PolicyChoice -> [(Name, Loc, DispatchDisposition)] -> [Diagnostic]+policyConsistency nodeName nodeLoc rejectedPolicy dispatches = contradictions ++ divergent ++ unused ++ ambiguityWarning+  where+    contradictions =+      [ mkErr (locLine dispatchLoc) PolicyContradiction $+          "dispatch '" <> command <> "' declares on-failed DeadLetter, but node '" <> nodeName <> "' does not declare rejected => deadLetter; align the dispatch story with the node-level RejectedCommandPolicy"+      | (command, dispatchLoc, disposition) <- dispatches,+        DDeadLetter _ <- [(.onFailed) disposition],+        rejectedPolicy /= PolDeadLetter+      ]++    divergent = case dispatches of+      [] -> []+      (_, _, firstDisposition) : rest ->+        [ mkErr (locLine dispatchLoc) PolicyContradiction $+            "dispatch '" <> command <> "' has a different on-failed action from another dispatch in node '" <> nodeName <> "'; the runtime applies one RejectedCommandPolicy to the whole failure group"+        | (command, dispatchLoc, disposition) <- rest,+          not (sameFailureAction ((.onFailed) disposition) ((.onFailed) firstDisposition))+        ]++    unused =+      [ Diagnostic (locLine nodeLoc) Warning PolicyDeadLetterUnused [] $+          "node '" <> nodeName <> "' declares rejected => deadLetter but no dispatch on-failed arm says DeadLetter; the runtime policy is live, but the per-dispatch notation does not acknowledge it"+      | rejectedPolicy == PolDeadLetter,+        all (not . isDeadLetter . (.onFailed) . third) dispatches+      ]++    ambiguityWarning =+      [ Diagnostic (locLine nodeLoc) Warning AmbiguousFollowsRejectedPolicy [] $+          "node '" <> nodeName <> "' acknowledges rejection-class failures; CommandAmbiguous follows the same rejected policy, and a dead-letter errorClass is the durable witness of that definition bug"+      | rejectedPolicy `elem` [PolDeadLetter, PolSkip]+      ]++    third (_, _, value) = value+    sameFailureAction DDeadLetter {} DDeadLetter {} = True+    sameFailureAction left right = left == right+    isDeadLetter DDeadLetter {} = True+    isDeadLetter _ = False++validateAggregate :: EffectiveLanguageContract -> Either (NE.NonEmpty TypeGraphError) TypeGraph -> Spec -> Aggregate -> [Diagnostic]+validateAggregate languageContract typeGraphResult spec agg =+  concat+    [ emptyAggregate,+      duplicateMembers,+      declaredRefs,+      eventBodyRefs,+      outputMappingRules,+      registerInitialScope,+      reachability,+      terminalNoOutgoing,+      guardScope,+      clockFree,+      projectionKeyResolution,+      projectionSafety,+      statusMapTotality,+      evolutionRules,+      snapshotRules,+      replayOnlyRules,+      eventlessStateChangeRules,+      domainOutcomeRules,+      wirePolicyRules,+      fieldWireKeyRules+    ]+  where+    emptyAggregate =+      [ mkErr (locLine ((.loc) agg)) AggregateEmpty $+          "aggregate '"+            <> (.name) agg+            <> "' declares "+            <> renderMissing missingAggregateParts+            <> "; scaffold cannot lower an empty aggregate -- declare at least one command, one event, and one transition"+      | not (null missingAggregateParts)+      ]+    missingAggregateParts =+      [ label+      | (isMissing, label) <-+          [ (null ((.commands) agg), "no commands"),+            (null ((.events) agg), "no events"),+            (null ((.transitions) agg), "no transitions")+          ],+        isMissing+      ]+    renderMissing [] = ""+    renderMissing [onlyPart] = onlyPart+    renderMissing [firstPart, secondPart] = firstPart <> " and " <> secondPart+    renderMissing parts = T.intercalate ", " (init parts) <> ", and " <> last parts++    states = Set.fromList (map (.name) ((.states) agg))+    terminals = Set.fromList [(.name) s | s <- (.states) agg, (.terminal) s]+    commandFields :: Map Name [Name]+    commandFields = Map.fromList [((.name) c, map (.name) ((.fields) c)) | c <- (.commands) agg]+    commandNames = Map.keysSet commandFields+    eventNames = Set.fromList (map (.name) ((.events) agg))+    enumCtorNames = Set.fromList [c | e <- (.enums) spec, (c, _) <- (.ctors) e]+    ruleNames = Set.fromList (map (.name) ((.rules) spec))+    registerNames = Set.fromList (map (.name) ((.regs) agg))++    eventFieldsFor event =+      case (.body) event of+        EventFields fields -> fields+        EventFromCommand commandName ->+          [ field+          | command <- (.commands) agg,+            (.name) command == commandName,+            field <- (.fields) command+          ]++    fieldWireKeyRules =+      concat+        [ wireKeyRulesForRecord+            ("aggregate '" <> (.name) agg <> "' command '" <> (.name) command <> "'")+            Nothing+            (map resolveAggregateFieldIdentity ((.fields) command))+        | command <- (.commands) agg+        ]+        <> concat+          [ wireKeyRulesForRecord+              ("aggregate '" <> (.name) agg <> "' event '" <> (.name) event <> "'")+              (Just ("kind", "event envelope key"))+              (map resolveAggregateFieldIdentity (eventFieldsFor event))+          | event <- (.events) agg+          ]++    snapshotRules = case (.snapshot) agg of+      Nothing -> []+      Just snapshot ->+        [ mkErr (locLine ((.loc) snapshot)) SnapshotIntervalInvalid $+            "aggregate '" <> (.name) agg <> "': snapshot every requires an interval of at least 1; non-positive runtime intervals silently disable snapshots"+        | SnapEvery interval <- [(.policy) snapshot],+          interval < 1+        ]+          ++ [ mkErr (locLine ((.loc) snapshot)) SnapshotCodecFixtureInvalid $+                 "aggregate '" <> (.name) agg <> "': snapshot state-codec version must be at least 1 and shape-hash must be non-empty"+             | (.codecVersion) snapshot < 1 || T.null ((.shapeHash) snapshot)+             ]++    wirePolicyRules = case (.wire) agg of+      Just wire+        | enforcesSpecSurfaceClosures languageContract,+          (.kind) wire /= "ctorName" || (.fields) wire /= "camelCase" ->+            [ mkErr (locLine ((.loc) agg)) WireClauseUnsupported $+                "aggregate '"+                  <> (.name) agg+                  <> "' wire clause describes kind="+                  <> (.kind) wire+                  <> " fields="+                  <> (.fields) wire+                  <> "; generated bytes currently support only kind=ctorName fields=camelCase"+            ]+      _ -> []++    duplicateMembers =+      [ mkErr (locLine ((.loc) c)) DuplicateCommandName $+          "aggregate '" <> (.name) agg <> "' declares command '" <> (.name) c <> "' more than once"+      | c <- duplicatesBy (.name) ((.commands) agg)+      ]+        ++ [ mkErr (locLine ((.loc) e)) DuplicateEventName $+               "aggregate '" <> (.name) agg <> "' declares event '" <> (.name) e <> "' more than once"+           | e <- duplicatesBy (.name) ((.events) agg)+           ]+        ++ [ mkErr (locLine ((.loc) field)) AggregateDuplicateFieldName $+               "aggregate '" <> (.name) agg <> "' command '" <> (.name) command <> "' declares field '" <> (.name) field <> "' more than once"+           | command <- (.commands) agg,+             field <- duplicatesBy (.name) ((.fields) command)+           ]+        ++ [ mkErr (locLine ((.loc) field)) AggregateDuplicateFieldName $+               "aggregate '" <> (.name) agg <> "' event '" <> (.name) event <> "' declares field '" <> (.name) field <> "' more than once"+           | event <- (.events) agg,+             EventFields fields <- [(.body) event],+             field <- duplicatesBy (.name) fields+           ]+        ++ [ mkErr (locLine ((.loc) state)) AggregateDuplicateState $+               "aggregate '" <> (.name) agg <> "' declares state '" <> (.name) state <> "' more than once"+           | state <- duplicatesBy (.name) ((.states) agg)+           ]+        ++ [ mkErr (locLine ((.loc) register)) AggregateDuplicateRegister $+               "aggregate '" <> (.name) agg <> "' declares register '" <> (.name) register <> "' more than once"+           | enforcesSpecSurfaceClosures languageContract,+             register <- duplicatesBy (.name) ((.regs) agg)+           ]+        ++ [ mkErr (locLine ((.loc) transition)) TransitionDuplicateUnguarded $+               "aggregate '"+                 <> (.name) agg+                 <> "' has more than one live unguarded transition for '"+                 <> (.source) transition+                 <> " -- "+                 <> (.command) transition+                 <> "'; every matching command would be ambiguous"+           | group <- duplicateGroupsBy transitionKey unguardedTransitions,+             transition <- group+           ]+        ++ [ mkErr (locLine ((.loc) guarded)) TransitionUnguardedSibling $+               "aggregate '"+                 <> (.name) agg+                 <> "' guarded transition '"+                 <> (.source) guarded+                 <> " -- "+                 <> (.command) guarded+                 <> "' overlaps an unguarded sibling at line "+                 <> tInt (locLine ((.loc) unguarded))+           | enforcesSpecSurfaceClosures languageContract,+             guarded <- liveTransitions,+             (.guard) guarded /= Nothing,+             unguarded : _ <- [[candidate | candidate <- unguardedTransitions, transitionKey candidate == transitionKey guarded]]+           ]+    liveTransitions = [transition | transition <- (.transitions) agg, (.mode) transition == TmLive]+    unguardedTransitions = [transition | transition <- liveTransitions, (.guard) transition == Nothing]+    transitionKey transition = ((.source) transition, (.command) transition)++    eventBodyRefs =+      [ mkErr (locLine ((.loc) e)) UndeclaredCommand $+          "event '" <> (.name) e <> "' copies fields from undeclared command '" <> command <> "'"+      | e <- (.events) agg,+        EventFromCommand command <- [(.body) e],+        command `Set.notMember` commandNames+      ]++    outputMappingRules =+      [ mkErr (locLine ((.loc) transition)) EventOutputCommandMismatch $+          "transition '"+            <> (.source) transition+            <> " -- "+            <> consuming+            <> "' emits event '"+            <> eventName+            <> "' declared as fields("+            <> declared+            <> "); generated identity output is legal only when the transition consumes that same command"+      | transition <- (.transitions) agg,+        (emitIndex, eventName) <- zip [1 ..] ((.emits) transition),+        Left OutputCommandMismatch {declaredSourceCommand = declared, consumingTransitionCommand = consuming} <- [eventOutputMappingFromGraphResult typeGraphResult spec agg transition emitIndex eventName]+      ]++    registerInitialScope = concatMap checkRegisterInitial ((.regs) agg)+    checkRegisterInitial r = case [e | e <- (.enums) spec, TRef ((.name) e) == (.valueType) r] of+      (e : _) -> case (.binding) e of+        Just _ ->+          [ outOfScope r "declaration-owned symbol selected by" "initial"+          | regInitialBare r /= Just "initial"+          ]+        Nothing ->+          [ outOfScope r "constructor of enum" ((.name) e)+          | regInitialBare r `notElem` map (Just . fst) ((.ctors) e)+          ]+      []+        | (.valueType) r == TRef ((.name) agg <> "Vertex") ->+            [ outOfScope r "state of aggregate" ((.name) agg)+            | maybe True (`Set.notMember` states) (regInitialBare r)+            ]+        | Just identifier <- firstMatching (\declaration -> (.valueType) r == TRef ((.name) declaration)) ((.ids) spec) -> case (.binding) identifier of+            Just _ ->+              [ outOfScope r "declaration-owned symbol selected by" "initial"+              | regInitialBare r /= Just "initial"+              ]+            Nothing ->+              [ outOfScope r "literal" "placeholder"+              | regInitialBare r /= Just "placeholder"+              ]+        | otherwise -> []+    outOfScope r expected domain =+      mkErr (locLine ((.loc) r)) RegisterInitialOutOfScope $+        "register '" <> (.name) r <> "' initial '" <> renderRegInitial ((.initial) r) <> "' is not a " <> expected <> " '" <> domain <> "'"+    regInitialBare r = case (.initial) r of+      RegInitBare value -> Just value+      RegInitText _ -> Nothing+    renderRegInitial = \case+      RegInitBare value -> value+      RegInitText value -> value++    -- Rule 1: declared-reference for command / emit / goto / source.+    declaredRefs =+      concatMap transitionRefs ((.transitions) agg)+    transitionRefs t =+      [ mkErr (locLine ((.loc) t)) UndeclaredCommand $+          "transition references undeclared command '" <> (.command) t <> "'"+      | not ((.command) t `Set.member` commandNames)+      ]+        ++ [ mkErr (locLine ((.loc) t)) UndeclaredState $+               "transition source '" <> (.source) t <> "' is not a declared state"+           | not ((.source) t `Set.member` states)+           ]+        ++ [ mkErr (locLine ((.loc) t)) UndeclaredState $+               "transition goto '" <> (.goto) t <> "' is not a declared state"+           | not ((.goto) t `Set.member` states)+           ]+        ++ [ mkErr (locLine ((.loc) t)) UndeclaredEvent $+               "emit references undeclared event '" <> ev <> "'"+           | ev <- (.emits) t,+             not (ev `Set.member` eventNames)+           ]++    -- Rule 2: reachability of every non-terminal state from the initial state+    -- (the first state in the list).+    reachability = case map (.name) ((.states) agg) of+      [] -> []+      (initial : _) ->+        let reached = bfs (Set.singleton initial) [initial]+         in [ mkErr (locLine ((.loc) s)) UnreachableState $+                "state '" <> (.name) s <> "' is not reachable from the initial state '" <> initial <> "'"+            | s <- (.states) agg,+              not ((.terminal) s),+              not ((.name) s `Set.member` reached)+            ]+    edgesFrom src = [(.goto) t | t <- (.transitions) agg, (.source) t == src]+    bfs seen [] = seen+    bfs seen (x : xs) =+      let nexts = [n | n <- edgesFrom x, not (n `Set.member` seen)]+       in bfs (foldr Set.insert seen nexts) (xs ++ nexts)++    -- Rule 3: a terminal state has no outgoing transition.+    terminalNoOutgoing =+      [ mkErr (locLine ((.loc) t)) TerminalHasOutgoing $+          "terminal state '" <> (.source) t <> "' has an outgoing transition"+      | t <- (.transitions) agg,+        (.source) t `Set.member` terminals+      ]++    -- Rule 4: every atom in a guard or write Expr resolves to a register, a+    -- field of the transition's command, an enum constructor, a rule, or a bool.+    guardScope = concatMap transitionScope ((.transitions) agg)+    transitionScope t =+      let inScope =+            registerNames+              `Set.union` Set.fromList (Map.findWithDefault [] ((.command) t) commandFields)+              `Set.union` enumCtorNames+              `Set.union` ruleNames+              -- State names are constructors of the implicit vertex enum, so a+              -- @write reservationState := Held@ references a state legitimately.+              `Set.union` states+          exprs = maybe [] pure ((.guard) t) ++ map snd ((.writes) t)+          badAtoms =+            [ n+            | e <- exprs,+              n <- exprNames e,+              not (n `Set.member` clockAtoms), -- clock atoms reported separately+              not (n `Set.member` inScope)+            ]+          badTargets = [target | (target, _) <- (.writes) t, target `Set.notMember` registerNames]+       in [ mkErr (locLine ((.loc) t)) WriteTargetNotRegister $+              "write target '" <> target <> "' is not a register of aggregate '" <> (.name) agg <> "'"+          | target <- dedup badTargets+          ]+            ++ [ mkErr (locLine ((.loc) t)) GuardAtomOutOfScope $+                   "atom '" <> n <> "' in transition '" <> (.source) t <> " -- " <> (.command) t <> "' resolves to no register, command field, enum constructor, or rule"+               | n <- dedup badAtoms+               ]++    -- Rule 5 (cross-cutting): no guard or write Expr samples a wall clock.+    clockFree = concatMap transitionClock ((.transitions) agg)+    transitionClock t =+      let exprs = maybe [] pure ((.guard) t) ++ map snd ((.writes) t)+          sampled = [n | e <- exprs, n <- exprNames e, n `Set.member` clockAtoms]+       in [ mkErr (locLine ((.loc) t)) ClockSampled $+              "transition '" <> (.source) t <> " -- " <> (.command) t <> "' samples the wall clock via '" <> n <> "'; time must be an injected input field, not sampled"+          | n <- dedup sampled+          ]++    -- EP-107: a projection references a first-class read model when one exists.+    -- Legacy standalone projections remain legal, but are surfaced as warnings.+    projectionKeyResolution =+      [ mkErr (locLine ((.loc) projection)) AggProjectionKeyUnresolved $+          "projection '" <> (.table) projection <> "' key '" <> (.key) projection <> "' is not a register, command field, or event field of aggregate '" <> (.name) agg <> "'"+      | enforcesSpecSurfaceClosures languageContract,+        Just projection <- [(.projection) agg],+        (.key) projection `Set.notMember` projectionFields+      ]+    projectionFields =+      registerNames+        `Set.union` Set.fromList [(.dslName) (resolveAggregateFieldIdentity field) | command <- (.commands) agg, field <- (.fields) command]+        `Set.union` Set.fromList [(.dslName) (resolveAggregateFieldIdentity field) | event <- (.events) agg, field <- eventFieldsFor event]++    projectionSafety = case (.projection) agg of+      Nothing -> []+      Just projection -> case [readModel | NReadModel readModel <- (.nodes) spec, (.name) readModel == (.table) projection] of+        [] ->+          [ mkErr (locLine ((.loc) projection)) RmStrongInlineOnly $+              "projection '" <> (.table) projection <> "' declares consistency = Strong but has no readmodel node; a standalone projection is inline-only and has no subscription cursor"+          | (.consistency) projection == Just Strong+          ]+            ++ [ Diagnostic+                   { line = locLine ((.loc) projection),+                     severity = Warning,+                     code = RmProjectionWithoutNode,+                     relatedLocations = [],+                     message = "projection '" <> (.table) projection <> "' has no readmodel node; registration, schema identity, consistency, and rebuild helpers are unavailable"+                   }+               ]+        (readModel : _) ->+          [ mkErr (locLine ((.loc) projection)) RmConsistencyConflict $+              "projection '" <> (.table) projection <> "' declares consistency " <> T.pack (show projectionConsistency) <> " but its readmodel node declares " <> T.pack (show readModelConsistency)+          | Just projectionConsistency <- [(.consistency) projection],+            Just readModelConsistency <- [legacyReadModelConsistency readModel],+            projectionConsistency /= readModelConsistency+          ]++    -- Rule 6 (hole-kind 3, mapping): keys are exact event names, never suffixes;+    -- duplicates and dangling keys are errors, and non-partial maps are total.+    statusMapTotality = case (.projection) agg of+      Nothing -> []+      Just p ->+        let evs = map (.name) ((.events) agg)+            pairs = maybe [] (.pairs) ((.statusMap) p)+            keys = map fst pairs+            partial = maybe False (.partial) ((.statusMap) p)+            uncovered = [event | event <- evs, event `notElem` keys]+            dangling = [key | key <- keys, key `notElem` evs]+            duplicateKeys = map fst (duplicatesBy fst pairs)+         in [ mkErr (locLine ((.loc) p)) StatusMapDanglingKey $+                "projection '" <> (.table) p <> "' status-map key '" <> key <> "' is not an event name of aggregate '" <> (.name) agg <> "'"+            | key <- dangling+            ]+              ++ [ mkErr (locLine ((.loc) p)) StatusMapDuplicateKey $+                     "projection '" <> (.table) p <> "' repeats status-map key '" <> key <> "'"+                 | key <- duplicateKeys+                 ]+              ++ [ mkErr (locLine ((.loc) p)) StatusMapNotTotal $+                     "projection '" <> (.table) p <> "' status-map is not total over events {" <> T.intercalate ", " uncovered <> "}"+                 | not partial,+                   not (null evs),+                   not (null uncovered)+                 ]++    -- EP-2 evolution rules (single-spec; the diff path adds the cross-spec ones).+    evolutionRules =+      versionUpcasterRule+        ++ upcasterChainGapRule+        ++ deprecatedEmitRule+        ++ eventRetirementRules+        ++ wireVersionRule+    -- Only live transitions are the write path: a replay-only transition can+    -- never fire forward, so its emits exist purely to invert stored events —+    -- which is exactly where a deprecated event is allowed to remain+    -- (plan 143; supersedes the guarded-but-inert retained-edge pattern).+    liveEmittedNames = Set.fromList (concatMap (.emits) [t | t <- (.transitions) agg, (.mode) t == TmLive])+    replayEmittedNames = Set.fromList (concatMap (.emits) [t | t <- (.transitions) agg, (.mode) t == TmReplayOnly])+    maxEventVersion = maximum (1 : map (.version) ((.events) agg))+    upcasterSources =+      Set.fromList+        [ source+        | event <- (.events) agg,+          Just (source, _) <- [(.upcastFrom) event]+        ]++    -- A non-initial event version must carry a contiguous upcaster (from v-1).+    versionUpcasterRule =+      [ mkErr (locLine ((.loc) e)) EvtVersionMissingUpcaster $+          "event '" <> (.name) e <> "' version " <> tInt ((.version) e) <> " has no 'upcast from v" <> tInt ((.version) e - 1) <> "' clause"+      | e <- (.events) agg,+        (.version) e > 1,+        maybe True ((/= (.version) e - 1) . fst) ((.upcastFrom) e)+      ]++    -- Aggregate schema stamps are global, so every source version below the+    -- current maximum needs a permanent rung regardless of which event owns it.+    upcasterChainGapRule =+      [ mkErr (locLine ((.loc) agg)) UpcasterChainGap $+          "no event declares 'upcast from v"+            <> tInt missing+            <> "'; stored payloads stamped v"+            <> tInt missing+            <> " can never reach v"+            <> tInt maxEventVersion+            <> " (GapInUpcasterChain at hydration). A rung, once shipped, must exist forever — restore the upcaster for v"+            <> tInt missing+            <> " (re-declare it on the event whose shape changed at v"+            <> tInt (missing + 1)+            <> ")"+      | missing <- [1 .. maxEventVersion - 1],+        missing `Set.notMember` upcasterSources+      ]++    -- A deprecated event must have left the write path.+    deprecatedEmitRule =+      [ mkErr (locLine ((.loc) e)) DeprecatedEventStillEmitted $+          "deprecated event '" <> (.name) e <> "' is still emitted by a transition"+      | e <- (.events) agg,+        (.deprecated) e,+        (.name) e `Set.member` liveEmittedNames+      ]++    -- Retirement is a two-stage protocol. The pre-cutover marker keeps a live+    -- emitter. The deprecated stage removes that live emitter but retains a+    -- replay-only emitter until old payloads no longer need hydration.+    eventRetirementRules = concatMap eventRetirementRule ((.events) agg)+    eventRetirementRule event+      | (.retiring) event =+          [ mkErr (locLine ((.loc) event)) EventRetirementInProgress $+              "retiring event '" <> (.name) event <> "' has no live emitting transition; keep it emitting while streams are terminalized or truncated, or cut over to 'deprecated event' with a replay-only emitting transition"+          | (.name) event `Set.notMember` liveEmittedNames+          ]+            ++ [ Diagnostic+                   { line = locLine ((.loc) event),+                     severity = Warning,+                     code = EventRetirementInProgress,+                     relatedLocations = [],+                     message =+                       "event '" <> (.name) event <> "' is retiring: it stays fully live and replayable. Keep its live emitting transition until every affected stream is terminal or truncated; then flip it to 'deprecated event' and retain an equivalent replay-only emitting transition for as long as old payloads may be hydrated"+                   }+               | (.name) event `Set.member` liveEmittedNames+               ]+      | (.deprecated) event =+          [ Diagnostic+              { line = locLine ((.loc) event),+                severity = Warning,+                code = DeprecatedEventReplayHazard,+                relatedLocations = [],+                message =+                  "deprecated event '" <> (.name) event <> "' stays decodable but is not replayable: no replay-only transition emits it, so hydration of a live stream containing it fails with HydrationNoInvertingEdge. Restore an equivalent replay-only emitting transition, or terminalize/truncate every affected stream before deployment"+              }+          | any (not . (.terminal)) ((.states) agg),+            (.name) event `Set.notMember` replayEmittedNames+          ]+            ++ [ Diagnostic+                   { line = locLine ((.loc) event),+                     severity = Warning,+                     code = EventRetirementInProgress,+                     relatedLocations = [],+                     message =+                       "deprecated event '" <> (.name) event <> "' is off the live write path and remains replayable through a replay-only transition; retain that transition until every stream containing the event is terminal, truncated, or passes the replay audit"+                   }+               | (.name) event `Set.member` replayEmittedNames+               ]+      | otherwise = []++    -- The explicit `wire schemaVersion=` (if any) must equal the max event version.+    wireVersionRule = case (.wire) agg of+      Just w+        | (.schemaVersion) w /= maxEventVersion ->+            [ Diagnostic+                { line = locLine ((.loc) agg),+                  severity = Warning,+                  code = WireSchemaVersionMismatch,+                  relatedLocations = [],+                  message =+                    "wire schemaVersion=" <> tInt ((.schemaVersion) w) <> " does not match the maximum event version " <> tInt maxEventVersion+                }+            ]+      _ -> []++    -- Plan 143: replay-only transition discipline. A replay-only transition+    -- exists to invert stored events, so one that emits nothing is dead+    -- weight (error); one whose (source, command) pair has no live sibling+    -- means the command is fully retired at that state — legitimate, but the+    -- fuller procedure is event retirement (docs/plans/139), so warn.+    replayOnlyRules = concatMap replayOnlyRule ((.transitions) agg)+    replayOnlyRule t+      | (.mode) t /= TmReplayOnly = []+      | otherwise =+          [ mkErr (locLine ((.loc) t)) ReplayOnlyEmitsNothing $+              "replay-only transition '" <> (.source) t <> " -- " <> (.command) t <> "' emits no event; a replay-only transition exists to invert stored events and is dead weight without an emit"+          | null ((.emits) t)+          ]+            ++ [ Diagnostic+                   { line = locLine ((.loc) t),+                     severity = Warning,+                     code = ReplayOnlyCommandStillLive,+                     relatedLocations = [],+                     message =+                       "replay-only transition '" <> (.source) t <> " -- " <> (.command) t <> "' has no live sibling; command '" <> (.command) t <> "' is fully retired at state '" <> (.source) t <> "' — if the intent is to retire its events too, follow the event-retirement procedure (docs/plans/139)"+                   }+               | not (any (\sibling -> (.mode) sibling == TmLive && (.source) sibling == (.source) t && (.command) sibling == (.command) t) ((.transitions) agg))+               ]++    eventlessStateChangeRules =+      [ mkErr (locLine ((.loc) transition)) AggregateEventlessStateChange $+          "transition '"+            <> (.source) transition+            <> " -- "+            <> (.command) transition+            <> "' emits no event but changes "+            <> changeDescription transition+            <> "; event-sourced state changes require persisted evidence, while a no-op must keep both vertex and registers unchanged"+      | transition <- (.transitions) agg,+        null ((.emits) transition),+        (.source) transition /= (.goto) transition || not (null ((.writes) transition))+      ]+    changeDescription transition+      | (.source) transition /= (.goto) transition && not (null ((.writes) transition)) = "the target vertex and registers"+      | (.source) transition /= (.goto) transition = "the target vertex"+      | otherwise = "registers"++    domainOutcomeRules =+      declarationRules+        ++ concatMap transitionOutcomeRules ((.transitions) agg)+      where+        declarationRules =+          [ mkErr (locLine loc) DomainOutcomeDeclarationDuplicate $+              "aggregate '" <> (.name) agg <> "' declares domain-outcomes more than once"+          | loc <- (.domainOutcomeDuplicateLocs) agg+          ]+            ++ case (.domainOutcomeTypes) agg of+              Nothing ->+                [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeDeclarationMissing $+                    "transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' declares an outcome but aggregate '" <> (.name) agg <> "' has no domain-outcomes declaration"+                | transition <- (.transitions) agg,+                  Just outcome <- [(.outcome) transition]+                ]+              Just _ -> []++        transitionOutcomeRules transition =+          [ mkErr (locLine loc) DomainOutcomeClauseDuplicate $+              "transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' declares outcome more than once"+          | loc <- (.outcomeDuplicateLocs) transition+          ]+            ++ case ((.domainOutcomeTypes) agg, (.mode) transition, (.outcome) transition) of+              (Just _, TmLive, Nothing) ->+                [ mkErr (locLine ((.loc) transition)) DomainOutcomeClauseMissing $+                    "live transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' is missing its required outcome clause"+                ]+              (Just _, TmReplayOnly, Just outcome) ->+                [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeReplayOnlyClause $+                    "replay-only transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' cannot declare a forward command outcome"+                ]+              (Just _, TmLive, Just (OutcomeAccepted loc)) ->+                [ mkErr (locLine loc) DomainOutcomeAcceptedWithoutEvents $+                    "accepted transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' must emit at least one event"+                | null ((.emits) transition)+                ]+              (Just _, TmLive, Just outcome@OutcomeRejected {}) -> silentRules outcome+              (Just _, TmLive, Just outcome@OutcomeNoOp {}) -> silentRules outcome+              _ -> []+          where+            silentRules outcome =+              [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentEmits $+                  "silent transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' cannot emit events"+              | not (null ((.emits) transition))+              ]+                ++ [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentWrites $+                       "silent transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' cannot write aggregate registers"+                   | not (null ((.writes) transition))+                   ]+                ++ [ mkErr (locLine (transitionOutcomeLoc outcome)) DomainOutcomeSilentStateChange $+                       "silent transition '" <> (.source) transition <> " -- " <> (.command) transition <> "' must preserve its source state"+                   | (.goto) transition /= (.source) transition+                   ]++-- | The validator's re-derivation of the live+-- 'Keiro.PGMQ.Runtime.queueRef' trio: physical queue, dead-letter queue, and+-- PGMQ backing table. Parity is pinned by the queue-runtime conformance suite.+derivedQueueTrio :: Text -> (Text, Text, Text)+derivedQueueTrio logical = (physical, physical <> "_dlq", "pgmq.q_" <> physical)+  where+    physical = physicalBase logical++physicalBase :: Text -> Text+physicalBase logical+  | T.length base <= 43 && not ("_dlq" `T.isSuffixOf` base) = base+  | otherwise = hashedBase logical base+  where+    base = sanitizeQueueName logical++sanitizeQueueName :: Text -> Text+sanitizeQueueName =+  ensureLeadingLetter+    . T.intercalate "_"+    . filter (not . T.null)+    . T.splitOn "_"+    . T.map toLegal+    . T.toLower+  where+    toLegal c+      | (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '_' = c+      | otherwise = '_'+    ensureLeadingLetter value = case T.uncons value of+      Nothing -> "q"+      Just (c, _)+        | c >= 'a' && c <= 'z' -> value+        | otherwise -> T.cons 'q' value++hashedBase :: Text -> Text -> Text+hashedBase logical base = prefix <> "_" <> fnv1a64Hex logical+  where+    trimmedPrefix = T.dropWhileEnd (== '_') (T.take 26 base)+    prefix+      | T.null trimmedPrefix = "q"+      | otherwise = trimmedPrefix++fnv1a64Hex :: Text -> Text+fnv1a64Hex logical = T.pack (replicate (16 - length rendered) '0' <> rendered)+  where+    rendered = showHex (T.foldl' step offset logical) ""+    offset :: Word64+    offset = 0xcbf29ce484222325+    prime :: Word64+    prime = 0x100000001b3+    step hash character = (hash `xor` fromIntegral (ord character)) * prime++tInt :: Int -> Text+tInt = T.pack . show++mkErr :: Int -> DiagnosticCode -> Text -> Diagnostic+mkErr l c m = Diagnostic {line = l, severity = Error, code = c, relatedLocations = [], message = m}++-- | A dispatch disposition as the author spelled it.+dispText :: Disp -> Text+dispText DAckOk = "AckOk"+dispText DRetry = "Retry"+dispText (DDeadLetter reason) = "DeadLetter " <> T.pack (show reason)++-- | A spec surface the grammar accepts but no runtime implements.+--+-- Released languages below 4 keep their acceptance and only warn, so an+-- existing source does not stop checking when it is pinned to an older+-- language. From language 4 — which promised strict spec-surface validation —+-- the same sentence is an error. The message never changes with the severity, so+-- an author reads one explanation before and after the tightening.+mkSurfaceRefusal :: EffectiveLanguageContract -> Int -> DiagnosticCode -> Text -> Diagnostic+mkSurfaceRefusal languageContract l c m =+  Diagnostic+    { line = l,+      severity = if enforcesSpecSurfaceClosures languageContract then Error else Warning,+      code = c,+      relatedLocations = [],+      message = m+    }++wireKeyRulesForRecord :: Text -> Maybe (Text, Text) -> [ResolvedFieldIdentity] -> [Diagnostic]+wireKeyRulesForRecord owner reservedKey fields = invalidKeys <> duplicateKeys <> reservedCollisions+  where+    -- Structural safety only. An alias exists to preserve a brownfield key that+    -- the current naming convention would reject, so checking alias *style*+    -- would defeat the feature. What is checked is that the key can be a key at+    -- all: a stray space or control character in `as "family "` ships a+    -- permanently mis-keyed public field that no later rename can fix without a+    -- wire break. See ADR 0021.+    invalidKeys = concatMap invalidKeyRule fields+    invalidKeyRule field+      | T.null key = [refuse "resolves to an empty wire key"]+      | key /= T.strip key =+          [ refuse+              ( "resolves to wire key "+                  <> T.pack (show key)+                  <> ", which has leading or trailing whitespace; the wire key is the exact bytes on the wire, so the surrounding space would be part of every encoded field name"+              )+          ]+      | Just offending <- firstMatching isControl (T.unpack key) =+          [ refuse+              ( "resolves to wire key "+                  <> T.pack (show key)+                  <> ", which contains the control character U+"+                  <> T.justifyRight 4 '0' (T.toUpper (T.pack (showHex (ord offending) "")))+              )+          ]+      | otherwise = []+      where+        key = (.wireKey) field+        refuse detail =+          mkErr (locLine ((.loc) field)) FieldWireKeyInvalid $+            owner <> " field '" <> (.dslName) field <> "' " <> detail+    duplicateKeys =+      [ Diagnostic+          { line = locLine ((.loc) field),+            severity = Error,+            code = FieldWireKeyCollision,+            relatedLocations = [(locLine ((.loc) earlier), "wire key '" <> (.wireKey) field <> "' is first declared here")],+            message = owner <> " fields resolve to duplicate wire key '" <> (.wireKey) field <> "'"+          }+      | (index, field) <- zip [0 :: Int ..] fields,+        earlier : _ <- [[candidate | candidate <- take index fields, (.wireKey) candidate == (.wireKey) field]]+      ]+    reservedCollisions =+      [ mkErr (locLine ((.loc) field)) FieldWireKeyCollision $+          owner+            <> " field '"+            <> (.dslName) field+            <> "' resolves to wire key '"+            <> key+            <> "', which collides with the "+            <> description+      | Just (key, description) <- [reservedKey],+        field <- fields,+        (.wireKey) field == key       ]  locLine :: Loc -> Int

src/Keiro/Dsl/Workspace.hs view

@@ -137,30 +137,30 @@ -- contradicts it. data WorkspaceManifest = WorkspaceManifest   { -- | The stable workspace identity, e.g. @demo-project@.-    wmfService :: !Text,-    wmfServiceLoc :: !Loc,+    service :: !Text,+    serviceLoc :: !Loc,     -- | The optional Cabal package that compiles this service's runtime.-    wmfRuntimePackage :: !(Maybe RuntimePackageName),+    runtimePackage :: !(Maybe RuntimePackageName),     -- | Meaningful only when 'wmfRuntimePackage' is 'Just'.-    wmfRuntimePackageLoc :: !Loc,+    runtimePackageLoc :: !Loc,     -- | The optional @module@ clause: the workspace's module-root authority.-    wmfModuleRoot :: !(Maybe Text),+    moduleRoot :: !(Maybe Text),     -- | Meaningful only when 'wmfModuleRoot' is 'Just'.-    wmfModuleRootLoc :: !Loc,+    moduleRootLoc :: !Loc,     -- | The optional @layout@ clause: the workspace's placement authority.-    wmfLayout :: !(Maybe Placement),+    layout :: !(Maybe Placement),     -- | Meaningful only when 'wmfLayout' is 'Just'.-    wmfLayoutLoc :: !Loc,+    layoutLoc :: !Loc,     -- | At least one member, in canonical order.-    wmfMembers :: !(NonEmpty WorkspaceMemberRef)+    members :: !(NonEmpty WorkspaceMemberRef)   }   deriving stock (Eq, Show)  -- | One @spec \<path\>@ line: the normalized manifest-relative member path. data WorkspaceMemberRef = WorkspaceMemberRef   { -- | Normalized: forward slashes, no @./@ segments, relative, ends in @.keiro@.-    wmrPath :: !FilePath,-    wmrLoc :: !Loc+    path :: !FilePath,+    loc :: !Loc   }   deriving stock (Eq, Show) @@ -352,15 +352,15 @@   let sorted = sortOn (T.pack . snd3) normalized   pure     WorkspaceManifest-      { wmfService = service,-        wmfServiceLoc = serviceLoc,-        wmfRuntimePackage = runtimePackage,-        wmfRuntimePackageLoc = runtimePackageLoc,-        wmfModuleRoot = moduleRoot,-        wmfModuleRootLoc = moduleLoc,-        wmfLayout = layout,-        wmfLayoutLoc = layoutLoc,-        wmfMembers = NE.fromList [WorkspaceMemberRef path loc | (_, path, loc) <- sorted]+      { service = service,+        serviceLoc = serviceLoc,+        runtimePackage = runtimePackage,+        runtimePackageLoc = runtimePackageLoc,+        moduleRoot = moduleRoot,+        moduleRootLoc = moduleLoc,+        layout = layout,+        layoutLoc = layoutLoc,+        members = NE.fromList [WorkspaceMemberRef path loc | (_, path, loc) <- sorted]       }   where     snd3 (_, path, _) = path@@ -411,12 +411,12 @@ renderWorkspaceManifest :: WorkspaceManifest -> Text renderWorkspaceManifest manifest =   T.intercalate "\n" $-    ["service " <> wmfService manifest]-      ++ maybe [] (\runtimeName -> ["runtime-package " <> unRuntimePackageName runtimeName]) (wmfRuntimePackage manifest)-      ++ maybe [] (\root -> ["module " <> root]) (wmfModuleRoot manifest)-      ++ maybe [] (\placement -> ["layout " <> renderPlacement placement]) (wmfLayout manifest)-      ++ [ "spec " <> T.pack (wmrPath member)-         | member <- sortOn (T.pack . wmrPath) (NE.toList (wmfMembers manifest))+    ["service " <> (.service) manifest]+      ++ maybe [] (\runtimeName -> ["runtime-package " <> (.unRuntimePackageName) runtimeName]) ((.runtimePackage) manifest)+      ++ maybe [] (\root -> ["module " <> root]) ((.moduleRoot) manifest)+      ++ maybe [] (\placement -> ["layout " <> renderPlacement placement]) ((.layout) manifest)+      ++ [ "spec " <> T.pack ((.path) member)+         | member <- sortOn (T.pack . (.path)) (NE.toList ((.members) manifest))          ]  renderPlacement :: Placement -> Text@@ -428,7 +428,7 @@ effectiveRuntimePackage :: Maybe RuntimePackageName -> WorkspaceManifest -> Maybe RuntimePackageName effectiveRuntimePackage cli manifest = case cli of   Just runtimeName -> Just runtimeName-  Nothing -> wmfRuntimePackage manifest+  Nothing -> (.runtimePackage) manifest  -------------------------------------------------------------------------------- -- Generic line relocation@@ -539,9 +539,9 @@ -- relevant ("also declared here", "member declares context 'kotei'"); it is -- unused for the primary position, which carries the diagnostic's own message. data WorkspaceLocation = WorkspaceLocation-  { wlFile :: !WorkspaceFile,-    wlLine :: !Int,-    wlRole :: !Text+  { file :: !WorkspaceFile,+    line :: !Int,+    role :: !Text   }   deriving stock (Eq, Show) @@ -551,11 +551,11 @@ -- single-spec diagnostics ("Keiro.Dsl.Validate"), so every gate stays -- correlatable by code. data WorkspaceDiagnostic = WorkspaceDiagnostic-  { wdLocations :: !(NonEmpty WorkspaceLocation),-    wdSeverity :: !Severity,-    wdCode :: !DiagnosticCode,-    wdSourceLanguageCause :: !(Maybe SourceLanguageDiagnostic),-    wdMessage :: !Text+  { locations :: !(NonEmpty WorkspaceLocation),+    severity :: !Severity,+    code :: !DiagnosticCode,+    sourceLanguageCause :: !(Maybe SourceLanguageDiagnostic),+    message :: !Text   }   deriving stock (Eq, Show) @@ -590,21 +590,21 @@ renderWorkspaceDiagnostic manifestPath diagnostic =   T.intercalate "\n" (primary : notes)   where-    primaryLocation :| secondary = wdLocations diagnostic+    primaryLocation :| secondary = (.locations) diagnostic     primary =       renderAt primaryLocation         <> ": "         <> severityWord         <> "["-        <> T.pack (show (wdCode diagnostic))+        <> T.pack (show ((.code) diagnostic))         <> "]: "-        <> wdMessage diagnostic-    notes = ["  " <> renderAt location <> ": note: " <> wlRole location | location <- secondary]+        <> (.message) diagnostic+    notes = ["  " <> renderAt location <> ": note: " <> (.role) location | location <- secondary]     renderAt location =-      T.pack (workspaceDisplayPath manifestPath (wlFile location))+      T.pack (workspaceDisplayPath manifestPath ((.file) location))         <> ":"-        <> T.pack (show (wlLine location))-    severityWord = case wdSeverity diagnostic of Error -> "error"; Warning -> "warning"+        <> T.pack (show ((.line) location))+    severityWord = case (.severity) diagnostic of Error -> "error"; Warning -> "warning"  -- | Render a whole failure as the lines a command should print to stderr. renderWorkspaceFailure :: FilePath -> WorkspaceFailure -> [Text]@@ -631,34 +631,34 @@ -- same keying the single-spec duplicate-node rule uses. Values are the owning -- member's manifest-relative path and its /original/ (unrelocated) location. data OwnershipIndex = OwnershipIndex-  { oiDeclarations :: !(Map (Text, Name) (FilePath, Loc)),-    oiNodes :: !(Map (Text, Name) (FilePath, Loc))+  { declarations :: !(Map (Text, Name) (FilePath, Loc)),+    nodes :: !(Map (Text, Name) (FilePath, Loc))   }   deriving stock (Eq, Show)  -- | Which member owns a shared declaration, e.g. @declarationOwner index "id" "ProjectId"@. declarationOwner :: OwnershipIndex -> Text -> Name -> Maybe (FilePath, Loc)-declarationOwner index namespace name = Map.lookup (namespace, name) (oiDeclarations index)+declarationOwner index namespace name = Map.lookup (namespace, name) ((.declarations) index)  -- | Which member owns a node, e.g. @nodeOwner index "aggregate" "Project"@. nodeOwner :: OwnershipIndex -> Text -> Name -> Maybe (FilePath, Loc)-nodeOwner index kind name = Map.lookup (kind, name) (oiNodes index)+nodeOwner index kind name = Map.lookup (kind, name) ((.nodes) index)  -- | One member of a composed workspace. data WorkspaceMember = WorkspaceMember   { -- | Normalized, manifest-relative.-    wmPath :: !FilePath,+    path :: !FilePath,     -- | Exactly as parsed: line numbers are the member's own.-    wmSpec :: !Spec,+    spec :: !Spec,     -- | The member's declared-versus-legacy source contract.-    wmSourceLanguage :: !SourceLanguage,+    sourceLanguage :: !SourceLanguage,     -- | Exact member-local semantic source provenance, using the normalized     -- manifest-relative member path.-    wmSourceIndex :: !SemanticSourceIndex,+    sourceIndex :: !SemanticSourceIndex,     -- | Added to this member's lines to place them in the merged spec.-    wmLineBase :: !Int,+    lineBase :: !Int,     -- | Source lines in the member file.-    wmLineCount :: !Int+    lineCount :: !Int   }   deriving stock (Eq, Show) @@ -674,23 +674,23 @@ -- between the single-file and workspace paths. data WorkspaceSpec = WorkspaceSpec   { -- | The stable workspace identity (the manifest's @service@ name).-    wsService :: !Text,-    wsManifestPath :: !FilePath,+    service :: !Text,+    manifestPath :: !FilePath,     -- | The unanimous effective contract selected before graph composition.     -- Member declared/legacy provenance remains in 'wsMembers'.-    wsLanguageContract :: !EffectiveLanguageContract,+    languageContract :: !EffectiveLanguageContract,     -- | The members' unanimous @context@.-    wsContext :: !Name,-    wsRuntimePackage :: !(Maybe RuntimePackageName),-    wsModuleRoot :: !(Maybe Text),-    wsLayout :: !(Maybe Placement),+    context :: !Name,+    runtimePackage :: !(Maybe RuntimePackageName),+    moduleRoot :: !(Maybe Text),+    layout :: !(Maybe Placement),     -- | Canonical order.-    wsMembers :: ![WorkspaceMember],-    wsMergedSpec :: !Spec,+    members :: ![WorkspaceMember],+    mergedSpec :: !Spec,     -- | Checked union of the members' exact, unrelocated source indices.-    wsSourceIndex :: !SemanticSourceIndex,-    wsLineMap :: !LineMap,-    wsOwnership :: !OwnershipIndex+    sourceIndex :: !SemanticSourceIndex,+    lineMap :: !LineMap,+    ownership :: !OwnershipIndex   }   deriving stock (Eq, Show) @@ -702,7 +702,7 @@   | otherwise =       listToMaybe         [ (path, n - low)-        | (low, high, path) <- lmRanges (wsLineMap workspace),+        | (low, high, path) <- (.lmRanges) ((.lineMap) workspace),           n > low,           n <= high         ]@@ -722,43 +722,43 @@   where     relative = takeFileName path     compatibilityIndex =-      either (const emptySemanticSourceIndex) id (compatibilitySemanticSourceIndex relative (parsedSpec parsedSource))+      either (const emptySemanticSourceIndex) id (compatibilitySemanticSourceIndex relative ((.spec) parsedSource))  -- | Adapt an exact parsed document to one-member workspace semantics while -- normalizing its index source path to the member path. oneMemberParsedDocumentWorkspace :: FilePath -> ParsedSourceDocument -> Either SourceIndexFailure WorkspaceSpec-oneMemberParsedDocumentWorkspace path ParsedSourceDocument {documentParsedSource = parsedSource, documentSourceIndex = sourceIndex} = do+oneMemberParsedDocumentWorkspace path ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex} = do   normalized <- repathSemanticSourceIndex path (takeFileName path) sourceIndex   pure (oneMemberWithIndex path parsedSource normalized)  oneMemberWithIndex :: FilePath -> ParsedSource -> SemanticSourceIndex -> WorkspaceSpec oneMemberWithIndex path parsedSource sourceIndex =   WorkspaceSpec-    { wsService = T.pack (takeBaseName path),-      wsManifestPath = path,-      wsLanguageContract = checkedLanguageContract service,-      wsContext = specContext spec,-      wsRuntimePackage = Nothing,-      wsModuleRoot = specModuleRoot spec,-      wsLayout = specLayout spec,-      wsMembers =+    { service = T.pack (takeBaseName path),+      manifestPath = path,+      languageContract = checkedLanguageContract service,+      context = (.context) spec,+      runtimePackage = Nothing,+      moduleRoot = (.moduleRoot) spec,+      layout = (.layout) spec,+      members =         [ WorkspaceMember-            { wmPath = relative,-              wmSpec = spec,-              wmSourceLanguage = parsedSourceLanguage parsedSource,-              wmSourceIndex = sourceIndex,-              wmLineBase = 0,-              wmLineCount = maximum (0 : collectLocs spec)+            { path = relative,+              spec = spec,+              sourceLanguage = (.sourceLanguage) parsedSource,+              sourceIndex = sourceIndex,+              lineBase = 0,+              lineCount = maximum (0 : collectLocs spec)             }         ],-      wsMergedSpec = spec,-      wsSourceIndex = sourceIndex,-      wsLineMap = LineMap [(0, maxBound, relative)],-      wsOwnership = ownershipOf [(relative, spec)]+      mergedSpec = spec,+      sourceIndex = sourceIndex,+      lineMap = LineMap [(0, maxBound, relative)],+      ownership = ownershipOf [(relative, spec)]     }   where     service = checkedSource parsedSource-    spec = parsedSpec parsedSource+    spec = (.spec) parsedSource     relative = takeFileName path  -- | Recover the contract-preserving semantic input from a composed workspace.@@ -766,7 +766,7 @@ -- contract, so downstream consumers need not inspect member provenance. checkedWorkspace :: WorkspaceSpec -> CheckedService checkedWorkspace workspace =-  checkedServiceForContract (wsLanguageContract workspace) (wsMergedSpec workspace)+  checkedServiceForContract ((.languageContract) workspace) ((.mergedSpec) workspace)  -- | Validate a composed workspace. This runs the /existing/ whole-spec -- validator over the merged spec once and maps each diagnostic's line back@@ -779,15 +779,15 @@ checkWorkspaceForService :: WorkspaceSpec -> CheckedService -> [WorkspaceDiagnostic] checkWorkspaceForService workspace service =   [ WorkspaceDiagnostic-      { wdLocations =-          locationFor (line diagnostic)-            :| [ (locationFor noteLine) {wlRole = note}-               | (noteLine, note) <- relatedLocations diagnostic+      { locations =+          locationFor ((.line) diagnostic)+            :| [ (locationFor noteLine) {role = note}+               | (noteLine, note) <- (.relatedLocations) diagnostic                ],-        wdSeverity = severity diagnostic,-        wdCode = code diagnostic,-        wdSourceLanguageCause = Nothing,-        wdMessage = message diagnostic+        severity = (.severity) diagnostic,+        code = (.code) diagnostic,+        sourceLanguageCause = Nothing,+        message = (.message) diagnostic       }   | diagnostic <- validateService service   ]@@ -832,40 +832,40 @@   | otherwise = Right composed   where     ordered =-      [ (ref, lookup (wmrPath ref) [(path, (text, document)) | (path, text, document) <- supplied])-      | ref <- NE.toList (wmfMembers manifest)+      [ (ref, lookup ((.path) ref) [(path, (text, document)) | (path, text, document) <- supplied])+      | ref <- NE.toList ((.members) manifest)       ]     unsupplied =       [ WorkspaceDiagnostic-          { wdLocations = pure (manifestLocation (wmrLoc ref) ""),-            wdSeverity = Error,-            wdCode = WorkspaceMemberUnreadable,-            wdSourceLanguageCause = Nothing,-            wdMessage = "workspace member '" <> T.pack (wmrPath ref) <> "' was not supplied to the composer"+          { locations = pure (manifestLocation ((.loc) ref) ""),+            severity = Error,+            code = WorkspaceMemberUnreadable,+            sourceLanguageCause = Nothing,+            message = "workspace member '" <> T.pack ((.path) ref) <> "' was not supplied to the composer"           }       | (ref, Nothing) <- ordered       ]     entries =-      [ (ref, text, parsedSourceLanguage parsedSource, parsedSpec parsedSource, sourceIndex)-      | (ref, Just (text, ParsedSourceDocument {documentParsedSource = parsedSource, documentSourceIndex = sourceIndex})) <- ordered+      [ (ref, text, (.sourceLanguage) parsedSource, (.spec) parsedSource, sourceIndex)+      | (ref, Just (text, ParsedSourceDocument {parsedSource = parsedSource, sourceIndex = sourceIndex})) <- ordered       ]      qualifiedIndexResults =       [ ( ref,           repathSemanticSourceIndex-            (workspaceDisplayPath manifestPath (WorkspaceMemberFile (wmrPath ref)))-            (wmrPath ref)+            (workspaceDisplayPath manifestPath (WorkspaceMemberFile ((.path) ref)))+            ((.path) ref)             sourceIndex         )       | (ref, _, _, _, sourceIndex) <- entries       ]     memberSourceIndexRefusals =       [ WorkspaceDiagnostic-          { wdLocations = pure (memberLocation ref (sourceIndexFailureLine indexFailure) ""),-            wdSeverity = Error,-            wdCode = WorkspaceSourceIndexInvalid,-            wdSourceLanguageCause = Nothing,-            wdMessage = "workspace member source index is incoherent: " <> sourceIndexFailureText indexFailure+          { locations = pure (memberLocation ref (sourceIndexFailureLine indexFailure) ""),+            severity = Error,+            code = WorkspaceSourceIndexInvalid,+            sourceLanguageCause = Nothing,+            message = "workspace member source index is incoherent: " <> sourceIndexFailureText indexFailure           }       | (ref, Left indexFailure) <- qualifiedIndexResults       ]@@ -874,17 +874,17 @@     unionSourceIndexRefusals = case workspaceSourceIndexResult of       Left indexFailure ->         [ WorkspaceDiagnostic-            { wdLocations = pure (sourceIndexFailureLocation indexFailure),-              wdSeverity = Error,-              wdCode = WorkspaceSourceIndexInvalid,-              wdSourceLanguageCause = Nothing,-              wdMessage = "workspace source-index union is incoherent: " <> sourceIndexFailureText indexFailure+            { locations = pure (sourceIndexFailureLocation indexFailure),+              severity = Error,+              code = WorkspaceSourceIndexInvalid,+              sourceLanguageCause = Nothing,+              message = "workspace source-index union is incoherent: " <> sourceIndexFailureText indexFailure             }         ]       Right _ -> []     sourceIndexRefusals = memberSourceIndexRefusals <> unionSourceIndexRefusals     sourceIndexFor ref =-      fromMaybe emptySemanticSourceIndex (lookup (wmrPath ref) [(wmrPath candidate, index) | (candidate, Right index) <- qualifiedIndexResults])+      fromMaybe emptySemanticSourceIndex (lookup ((.path) ref) [((.path) candidate, index) | (candidate, Right index) <- qualifiedIndexResults])      refusals =       languageRefusals@@ -904,7 +904,7 @@       | length effectiveVersions <= 1 = []       | otherwise =           [ WorkspaceDiagnostic-              { wdLocations =+              { locations =                   NE.fromList                     [ memberLocation                         ref@@ -912,10 +912,10 @@                         ("member selects effective language version " <> languageVersionText (effectiveLanguageVersion sourceLanguage))                     | (ref, text, sourceLanguage, _, _) <- entries                     ],-                wdSeverity = Error,-                wdCode = WorkspaceLanguageVersionMismatch,-                wdSourceLanguageCause = Nothing,-                wdMessage =+                severity = Error,+                code = WorkspaceLanguageVersionMismatch,+                sourceLanguageCause = Nothing,+                message =                   "workspace members select different effective language versions ("                     <> T.intercalate ", " (map languageVersionText effectiveVersions)                     <> "); one semantic graph cannot combine different language contracts"@@ -924,25 +924,25 @@     sourceLanguageLine text LegacyUnversioned = clauseLine "context" text     sourceLanguageLine _ DeclaredLanguage {languageVersionLoc = Loc lineNumber} = Just lineNumber -    declaredContexts = nub [specContext spec | (_, _, _, spec, _) <- entries]+    declaredContexts = nub [(.context) spec | (_, _, _, spec, _) <- entries]     effectiveContext = case entries of-      (_, _, _, spec, _) : _ -> specContext spec+      (_, _, _, spec, _) : _ -> (.context) spec       [] -> ""     contextRefusals       | length declaredContexts <= 1 = []       | otherwise =           [ WorkspaceDiagnostic-              { wdLocations =+              { locations =                   NE.fromList-                    [ memberLocation ref (clauseLine "context" text) ("member declares context '" <> specContext spec <> "'")+                    [ memberLocation ref (clauseLine "context" text) ("member declares context '" <> (.context) spec <> "'")                     | (ref, text, _, spec, _) <- entries                     ],-                wdSeverity = Error,-                wdCode = WorkspaceContextMismatch,-                wdSourceLanguageCause = Nothing,-                wdMessage =+                severity = Error,+                code = WorkspaceContextMismatch,+                sourceLanguageCause = Nothing,+                message =                   "workspace '"-                    <> wmfService manifest+                    <> (.service) manifest                     <> "' members declare different contexts ("                     <> T.intercalate ", " (sort declaredContexts)                     <> "); every member of one workspace must declare the same context"@@ -953,9 +953,9 @@     -- Effective module root and layout     --------------------------------------------------------------------------     (effectiveModuleRoot, moduleRefusals) =-      resolveAuthority "module" id (wmfModuleRoot manifest) (wmfModuleRootLoc manifest) specModuleRoot+      resolveAuthority "module" id ((.moduleRoot) manifest) ((.moduleRootLoc) manifest) (.moduleRoot)     (effectiveLayout, layoutRefusals) =-      resolveAuthority "layout" renderPlacement (wmfLayout manifest) (wmfLayoutLoc manifest) specLayout+      resolveAuthority "layout" renderPlacement ((.layout) manifest) ((.layoutLoc) manifest) (.layout)      -- The absent-or-exactly-equal authority rule, shared by @module@ and     -- @layout@. When the manifest declares the clause it is the authority and@@ -978,15 +978,15 @@         Just authority ->           ( Just authority,             [ WorkspaceDiagnostic-                { wdLocations =+                { locations =                     manifestLocation manifestLoc ""                       :| [ memberLocation ref (clauseLine clauseKeyword text) ("member declares " <> clauseKeyword <> " " <> renderValue value)                          | (ref, text, value) <- disagreeing                          ],-                  wdSeverity = Error,-                  wdCode = WorkspaceAuthorityConflict,-                  wdSourceLanguageCause = Nothing,-                  wdMessage =+                  severity = Error,+                  code = WorkspaceAuthorityConflict,+                  sourceLanguageCause = Nothing,+                  message =                     "workspace manifest declares "                       <> clauseKeyword                       <> " "@@ -1010,15 +1010,15 @@           | otherwise ->               ( Nothing,                 [ WorkspaceDiagnostic-                    { wdLocations =+                    { locations =                         NE.fromList                           [ memberLocation ref (clauseLine clauseKeyword text) ("member declares " <> clauseKeyword <> " " <> renderValue value)                           | (ref, text, value) <- declared                           ],-                      wdSeverity = Error,-                      wdCode = WorkspaceAuthorityConflict,-                      wdSourceLanguageCause = Nothing,-                      wdMessage =+                      severity = Error,+                      code = WorkspaceAuthorityConflict,+                      sourceLanguageCause = Nothing,+                      message =                         "the workspace manifest declares no "                           <> clauseKeyword                           <> " clause, so the members that declare one must agree; they do not"@@ -1040,40 +1040,40 @@       ]     declarationRefusals =       [ WorkspaceDiagnostic-          { wdLocations =+          { locations =               NE.fromList                 [ memberLocation ref (Just (unLoc loc)) ("also declared here, as " <> namespace <> " '" <> name <> "'")                 | (namespace, ref, loc) <- sites                 ],-            wdSeverity = Error,-            wdCode = WorkspaceDuplicateDeclaration,-            wdSourceLanguageCause = Nothing,-            wdMessage =+            severity = Error,+            code = WorkspaceDuplicateDeclaration,+            sourceLanguageCause = Nothing,+            message =               "duplicate declaration '"                 <> name                 <> "': a shared declaration has exactly one owning member (identical duplicates do not merge)"           }       | (name, sites) <- groupSites declarationSites,-        length (nub [wmrPath ref | (_, ref, _) <- sites]) > 1+        length (nub [(.path) ref | (_, ref, _) <- sites]) > 1       ]      nodeSites =       [ ((kind, name), (ref, loc))       | (ref, _, _, spec, _) <- entries,-        node <- specNodes spec,+        node <- (.nodes) spec,         let (kind, name, loc) = nodeIdentity node       ]     nodeRefusals =       [ WorkspaceDiagnostic-          { wdLocations =+          { locations =               NE.fromList                 [ memberLocation ref (Just (unLoc loc)) ("also defined here")                 | (ref, loc) <- sites                 ],-            wdSeverity = Error,-            wdCode = WorkspaceDuplicateNodeName,-            wdSourceLanguageCause = Nothing,-            wdMessage =+            severity = Error,+            code = WorkspaceDuplicateNodeName,+            sourceLanguageCause = Nothing,+            message =               "duplicate "                 <> kind                 <> " node name '"@@ -1081,7 +1081,7 @@                 <> "': a node has exactly one owning member"           }       | ((kind, name), sites) <- groupSites nodeSites,-        length (nub [wmrPath ref | (ref, _) <- sites]) > 1+        length (nub [(.path) ref | (ref, _) <- sites]) > 1       ]      --------------------------------------------------------------------------@@ -1091,35 +1091,35 @@     lineBases = scanl (+) 0 lineCounts     members =       [ WorkspaceMember-          { wmPath = wmrPath ref,-            wmSpec = spec,-            wmSourceLanguage = sourceLanguage,-            wmSourceIndex = sourceIndexFor ref,-            wmLineBase = base,-            wmLineCount = memberLines+          { path = (.path) ref,+            spec = spec,+            sourceLanguage = sourceLanguage,+            sourceIndex = sourceIndexFor ref,+            lineBase = base,+            lineCount = memberLines           }       | ((ref, _, sourceLanguage, spec, _), base, memberLines) <- zip3 entries lineBases lineCounts       ]-    relocatedSpecs = [relocateLocs (shiftBy (wmLineBase member)) (wmSpec member) | member <- members]+    relocatedSpecs = [relocateLocs (shiftBy ((.lineBase) member)) ((.spec) member) | member <- members]     -- The placeholder location 'Loc 0' must stay 0: shifting it would land it     -- inside the previous member's range and mis-attribute the diagnostic.     shiftBy base n = if n <= 0 then n else n + base     lineMap =       LineMap-        [ (wmLineBase member, wmLineBase member + wmLineCount member, wmPath member)+        [ ((.lineBase) member, (.lineBase) member + (.lineCount) member, (.path) member)         | member <- members         ]     mergedSpec =       Spec-        { specContext = effectiveContext,-          specModuleRoot = effectiveModuleRoot,-          specLayout = effectiveLayout,-          specIds = concatMap specIds relocatedSpecs,-          specEnums = concatMap specEnums relocatedSpecs,-          specRules = concatMap specRules relocatedSpecs,-          specNominalScalars = concatMap specNominalScalars relocatedSpecs,-          specMapped = concatMap specMapped relocatedSpecs,-          specNodes = concatMap specNodes relocatedSpecs+        { context = effectiveContext,+          moduleRoot = effectiveModuleRoot,+          layout = effectiveLayout,+          ids = concatMap (.ids) relocatedSpecs,+          enums = concatMap (.enums) relocatedSpecs,+          rules = concatMap (.rules) relocatedSpecs,+          nominalScalars = concatMap (.nominalScalars) relocatedSpecs,+          mapped = concatMap (.mapped) relocatedSpecs,+          nodes = concatMap (.nodes) relocatedSpecs         }      --------------------------------------------------------------------------@@ -1127,7 +1127,7 @@     --------------------------------------------------------------------------     plannerContext =       Context-        { contextName = effectiveContext,+        { name = effectiveContext,           moduleRoot = fromMaybe "" effectiveModuleRoot,           placement = fromMaybe GeneratedPrefix effectiveLayout         }@@ -1139,7 +1139,7 @@       -- An invalid merged spec is 'checkWorkspace''s report to make, and the       -- planner is only designed to see specs that passed validation.       | any blocksCollisionPlanning (validateService collisionService) = []-      | otherwise = case planIndexedServiceScaffoldWithRuntimePackageAndGoldens [] (wmfRuntimePackage manifest) (wsSourceIndex composed) plannerContext collisionService of+      | otherwise = case planIndexedServiceScaffoldWithRuntimePackageAndGoldens [] ((.runtimePackage) manifest) ((.sourceIndex) composed) plannerContext collisionService of           Right _ -> []           Left plannerRefusals -> concatMap planningRefusal plannerRefusals     collisionService = checkedWorkspace composed@@ -1148,30 +1148,30 @@       workspaceDiagnostics -> workspaceDiagnostics     liftPlanningDiagnostic diagnostic =       WorkspaceDiagnostic-        { wdLocations =-            planningLocation (line diagnostic) ""+        { locations =+            planningLocation ((.line) diagnostic) ""               :| [ planningLocation noteLine note-                 | (noteLine, note) <- relatedLocations diagnostic+                 | (noteLine, note) <- (.relatedLocations) diagnostic                  ],-          wdSeverity = severity diagnostic,-          wdCode = code diagnostic,-          wdSourceLanguageCause = Nothing,-          wdMessage = message diagnostic+          severity = (.severity) diagnostic,+          code = (.code) diagnostic,+          sourceLanguageCause = Nothing,+          message = (.message) diagnostic         }     planningLocation mergedLine role = case lookupLine mergedLine of       Just (owner, original) -> WorkspaceLocation (WorkspaceMemberFile owner) original role       Nothing -> WorkspaceLocation WorkspaceManifestFile (max 1 mergedLine) role     crossMemberCollision (PathCollision path origins) =       [ WorkspaceDiagnostic-          { wdLocations =+          { locations =               NE.fromList                 [ WorkspaceLocation (WorkspaceMemberFile owner) original ("claimed here by " <> origin)                 | (origin, owner, original) <- resolved                 ],-            wdSeverity = Error,-            wdCode = WorkspacePathCollision,-            wdSourceLanguageCause = Nothing,-            wdMessage =+            severity = Error,+            code = WorkspacePathCollision,+            sourceLanguageCause = Nothing,+            message =               "generated module path '"                 <> T.pack path                 <> "' is claimed by nodes in more than one member; on a case-insensitive filesystem these are one file"@@ -1187,12 +1187,12 @@           ]     crossMemberCollision _ = []     blocksCollisionPlanning diagnostic =-      severity diagnostic == Error-        && code diagnostic /= GeneratedOccurrenceCollision+      (.severity) diagnostic == Error+        && (.code) diagnostic /= GeneratedOccurrenceCollision     lookupLine n =       listToMaybe         [ (path, n - low)-        | (low, high, path) <- lmRanges lineMap,+        | (low, high, path) <- (.lmRanges) lineMap,           n > low,           n <= high         ]@@ -1202,18 +1202,18 @@     --------------------------------------------------------------------------     composed =       WorkspaceSpec-        { wsService = wmfService manifest,-          wsManifestPath = manifestPath,-          wsLanguageContract = effectiveLanguageContract effectiveSourceLanguage,-          wsContext = effectiveContext,-          wsRuntimePackage = wmfRuntimePackage manifest,-          wsModuleRoot = effectiveModuleRoot,-          wsLayout = effectiveLayout,-          wsMembers = members,-          wsMergedSpec = mergedSpec,-          wsSourceIndex = either (const emptySemanticSourceIndex) id workspaceSourceIndexResult,-          wsLineMap = lineMap,-          wsOwnership = ownershipOf [(wmPath member, wmSpec member) | member <- members]+        { service = (.service) manifest,+          manifestPath = manifestPath,+          languageContract = effectiveLanguageContract effectiveSourceLanguage,+          context = effectiveContext,+          runtimePackage = (.runtimePackage) manifest,+          moduleRoot = effectiveModuleRoot,+          layout = effectiveLayout,+          members = members,+          mergedSpec = mergedSpec,+          sourceIndex = either (const emptySemanticSourceIndex) id workspaceSourceIndexResult,+          lineMap = lineMap,+          ownership = ownershipOf [((.path) member, (.spec) member) | member <- members]         }      effectiveSourceLanguage = case entries of@@ -1222,14 +1222,14 @@      manifestLocation loc role = WorkspaceLocation WorkspaceManifestFile (max 1 (unLoc loc)) role     memberLocation ref found role =-      WorkspaceLocation (WorkspaceMemberFile (wmrPath ref)) (fromMaybe 1 found) role-    sourceIndexFailureLine SourceIndexFailure {failureSpan} =+      WorkspaceLocation (WorkspaceMemberFile ((.path) ref)) (fromMaybe 1 found) role+    sourceIndexFailureLine SourceIndexFailure {span = failureSpan} =       fmap (\SourceSpan {start = SourcePoint {line}} -> line) failureSpan-    sourceIndexFailureLocation indexFailure@SourceIndexFailure {failureSpan} = case failureSpan of+    sourceIndexFailureLocation indexFailure@SourceIndexFailure {span = failureSpan} = case failureSpan of       Just SourceSpan {source, start = SourcePoint {line}} -> WorkspaceLocation (WorkspaceMemberFile source) line ""       Nothing -> WorkspaceLocation WorkspaceManifestFile 1 (sourceIndexFailureText indexFailure)-    sourceIndexFailureText SourceIndexFailure {failureCode, failureMessage} =-      T.pack (show failureCode) <> ": " <> failureMessage+    sourceIndexFailureText SourceIndexFailure {code, message} =+      T.pack (show code) <> ": " <> message  -- | Group @(key, site)@ pairs by key, preserving first-appearance order. groupSites :: (Ord k) => [(k, v)] -> [(k, [v])]@@ -1244,11 +1244,11 @@ -- | The four shared-declaration namespaces of one spec, with names and lines. sharedDeclarations :: Spec -> [(Text, Name, Loc)] sharedDeclarations spec =-  [("id", idName d, idLoc d) | d <- specIds spec]-    <> [("enum", enumName d, enumLoc d) | d <- specEnums spec]-    <> [("rule", ruleName d, ruleLoc d) | d <- specRules spec]-    <> [("nominal", nominalScalarName d, nominalScalarLoc d) | d <- specNominalScalars spec]-    <> [("mapped", mappedDeclName d, mappedDeclLoc d) | d <- specMapped spec]+  [("id", (.name) d, (.loc) d) | d <- (.ids) spec]+    <> [("enum", (.name) d, (.loc) d) | d <- (.enums) spec]+    <> [("rule", (.name) d, (.loc) d) | d <- (.rules) spec]+    <> [("nominal", (.name) d, (.loc) d) | d <- (.nominalScalars) spec]+    <> [("mapped", mappedDeclName d, mappedDeclLoc d) | d <- (.mapped) spec]  mappedDeclName :: MappedDecl -> Name mappedDeclName MappedStructural {msName = name} = name@@ -1262,17 +1262,17 @@ ownershipOf :: [(FilePath, Spec)] -> OwnershipIndex ownershipOf members =   OwnershipIndex-    { oiDeclarations =+    { declarations =         Map.fromList           [ ((namespace, name), (path, loc))           | (path, spec) <- members,             (namespace, name, loc) <- sharedDeclarations spec           ],-      oiNodes =+      nodes =         Map.fromList           [ ((kind, name), (path, loc))           | (path, spec) <- members,-            node <- specNodes spec,+            node <- (.nodes) spec,             let (kind, name, loc) = nodeIdentity node           ]     }@@ -1330,13 +1330,13 @@ -- being adopted at once. loadWorkspace :: ContentSource -> FilePath -> IO (Either WorkspaceFailure WorkspaceSpec) loadWorkspace source manifestPath = do-  manifestRead <- csRead source (takeFileName manifestPath)+  manifestRead <- (.csRead) source (takeFileName manifestPath)   case manifestRead of     Left reason -> pure (Left (WorkspaceManifestUnreadable reason))     Right manifestText -> case parseWorkspaceManifest manifestPath manifestText of       Left err -> pure (Left (WorkspaceManifestUnparseable err))       Right manifest -> do-        results <- traverse readMember (NE.toList (wmfMembers manifest))+        results <- traverse readMember (NE.toList ((.members) manifest))         case [diagnostic | Left diagnostic <- results] of           (d : ds) -> pure (Left (WorkspaceRefused (d :| ds)))           [] ->@@ -1347,26 +1347,26 @@               )   where     readMember ref = do-      result <- csRead source (wmrPath ref)+      result <- (.csRead) source ((.path) ref)       pure $ case result of-        Left reason -> Left (memberFailure ref WorkspaceMemberUnreadable ("workspace member '" <> T.pack (wmrPath ref) <> "' could not be read: " <> reason) Nothing)-        Right text -> case parseSourceDocument (workspaceDisplayPath manifestPath (WorkspaceMemberFile (wmrPath ref))) text of+        Left reason -> Left (memberFailure ref WorkspaceMemberUnreadable ("workspace member '" <> T.pack ((.path) ref) <> "' could not be read: " <> reason) Nothing)+        Right text -> case parseSourceDocument (workspaceDisplayPath manifestPath (WorkspaceMemberFile ((.path) ref))) text of           Left parseFailure ->             Left               ( memberFailure                   ref                   WorkspaceMemberParseFailed-                  ("workspace member '" <> T.pack (wmrPath ref) <> "' failed to parse:\n" <> renderParseFailure parseFailure)+                  ("workspace member '" <> T.pack ((.path) ref) <> "' failed to parse:\n" <> renderParseFailure parseFailure)                   (case parseFailure of SourceLanguageFailure diagnostic -> Just diagnostic; BodyGrammarFailure {} -> Nothing)               )-          Right document -> Right (wmrPath ref, text, document)-    memberFailure ref failureCode note sourceLanguageCause =+          Right document -> Right ((.path) ref, text, document)+    memberFailure ref code note sourceLanguageCause =       WorkspaceDiagnostic-        { wdLocations = pure (WorkspaceLocation WorkspaceManifestFile (max 1 (unLoc (wmrLoc ref))) ""),-          wdSeverity = Error,-          wdCode = failureCode,-          wdSourceLanguageCause = sourceLanguageCause,-          wdMessage = note+        { locations = pure (WorkspaceLocation WorkspaceManifestFile (max 1 (unLoc ((.loc) ref))) ""),+          severity = Error,+          code = code,+          sourceLanguageCause = sourceLanguageCause,+          message = note         }  --------------------------------------------------------------------------------

src/Keiro/Dsl/WorkspaceAdoption.hs view

@@ -60,24 +60,24 @@   deriving stock (Eq, Show)  data ClaimedFile = ClaimedFile-  { cfPath :: !FilePath,-    cfEvidence :: !ClaimEvidence,+  { path :: !FilePath,+    evidence :: !ClaimEvidence,     -- | The legacy record's file name, for @record@ evidence.-    cfSource :: !(Maybe Text),+    source :: !(Maybe Text),     -- | The legacy record's @spec:@ field, for @record@ evidence.-    cfSpec :: !(Maybe Text)+    spec :: !(Maybe Text)   }   deriving stock (Eq, Show)  -- | What one adopting run found. Printed in the scaffold output and persisted -- beside the generated tree as the durable review artifact. data MigrationReport = MigrationReport-  { mrService :: !Text,+  { service :: !Text,     -- | The legacy record consulted, as @(file name, its @spec:@ field)@.-    mrLegacyRecord :: !(Maybe (FilePath, Text)),-    mrClaimed :: ![ClaimedFile],-    mrLikelyStale :: ![StaleModule],-    mrUnclaimed :: ![FilePath]+    legacyRecord :: !(Maybe (FilePath, Text)),+    claimed :: ![ClaimedFile],+    likelyStale :: ![StaleModule],+    unclaimed :: ![FilePath]   }   deriving stock (Eq, Show) @@ -94,25 +94,25 @@   present <- Set.fromList <$> outputTreeFiles out   let legacyName = maybe (contextLedgerFileName context) fst ledger       legacy = snd <$> ledger-      plannedGenerated = [modulePath m | m <- modules, kind m == Generated]-      plannedAll = Set.fromList (map modulePath modules)+      plannedGenerated = [(.path) m | m <- modules, (.kind) m == Generated]+      plannedAll = Set.fromList (map (.path) modules)       onDisk path = path `Set.member` present -      recordedFiles = maybe [] recFiles legacy-      recordSpec = fmap recSpecPath legacy+      recordedFiles = maybe [] (.files) legacy+      recordSpec = fmap (.specPath) legacy        claimedFromRecord =         [ ClaimedFile-            { cfPath = path,-              cfEvidence = ClaimedFromRecord,-              cfSource = Just (T.pack legacyName),-              cfSpec = recordSpec+            { path = path,+              evidence = ClaimedFromRecord,+              source = Just (T.pack legacyName),+              spec = recordSpec             }         | (Generated, path) <- recordedFiles,           path `Set.member` plannedAll,           onDisk path         ]-      recordClaimedPaths = Set.fromList (map cfPath claimedFromRecord)+      recordClaimedPaths = Set.fromList (map (.path) claimedFromRecord)    -- A banner claim reads the file, so it is filtered before the read.   bannerCandidates <-@@ -123,15 +123,15 @@         onDisk path,         path `Set.notMember` recordClaimedPaths       ]-  likelyStale <- staleAgainst out (map modulePath modules) recordedFiles+  likelyStale <- staleAgainst out (map (.path) modules) recordedFiles   let claimedFromBanner =-        [ ClaimedFile {cfPath = path, cfEvidence = ClaimedFromBanner, cfSource = Nothing, cfSpec = Nothing}+        [ ClaimedFile {path = path, evidence = ClaimedFromBanner, source = Nothing, spec = Nothing}         | (path, True) <- bannerCandidates         ]       claimed = claimedFromRecord <> claimedFromBanner        staleOrGenerated =-        Set.fromList (map stalePath likelyStale) <> Set.fromList plannedGenerated+        Set.fromList (map (.path) likelyStale) <> Set.fromList plannedGenerated        -- Everything left on disk that this run neither produces nor       -- attributes. Planned Generated paths are excluded because this run@@ -140,11 +140,11 @@        report =         MigrationReport-          { mrService = service,-            mrLegacyRecord = (,) legacyName <$> recordSpec,-            mrClaimed = claimed,-            mrLikelyStale = likelyStale,-            mrUnclaimed = unclaimed+          { service = service,+            legacyRecord = (,) legacyName <$> recordSpec,+            claimed = claimed,+            likelyStale = likelyStale,+            unclaimed = unclaimed           }   pure $     if null claimed && null likelyStale && null unclaimed && isNothing legacy@@ -155,14 +155,14 @@ adoptedRows :: MigrationReport -> [AdoptedRow] adoptedRows report =   [ AdoptedRow-      { adPath = cfPath claimed,-        adEvidence = case cfEvidence claimed of+      { path = (.path) claimed,+        evidence = case (.evidence) claimed of           ClaimedFromRecord -> "record"           ClaimedFromBanner -> "banner",-        adSource = cfSource claimed,-        adSpec = cfSpec claimed+        source = (.source) claimed,+        spec = (.spec) claimed       }-  | claimed <- mrClaimed report+  | claimed <- (.claimed) report   ]  -- | Append the supersession marker to a legacy record, once. Appending is@@ -228,29 +228,29 @@ -- written to @keiro-dsl-migration-report.workspace.\<service\>.txt@. renderMigrationReport :: MigrationReport -> [Text] renderMigrationReport report =-  [ "migration: adopting pre-workspace scaffold output into workspace " <> mrService report+  [ "migration: adopting pre-workspace scaffold output into workspace " <> (.service) report   ]     <> legacySection     <> claimedSection     <> staleSection     <> unclaimedSection     <> [ "note: keiro-dsl never deletes files. The legacy record was marked superseded, not removed.",-         "note: the full report is kept at " <> T.pack (workspaceMigrationReportFileName (mrService report))+         "note: the full report is kept at " <> T.pack (workspaceMigrationReportFileName ((.service) report))        ]   where-    legacySection = case mrLegacyRecord report of+    legacySection = case (.legacyRecord) report of       Nothing -> ["  legacy record: (none for this context)"]       Just (name, specPath) -> ["  legacy record: " <> T.pack name <> " (spec " <> specPath <> ")"]-    claimedSection = case mrClaimed report of+    claimedSection = case (.claimed) report of       [] -> ["  claimed: nothing was attributable to this workspace"]       claimed ->         ["  claimed " <> tshow (length claimed) <> " file(s) into workspace history:"]-          <> [ "    " <> evidenceTag (cfEvidence entry) <> "  " <> T.pack (cfPath entry)+          <> [ "    " <> evidenceTag ((.evidence) entry) <> "  " <> T.pack ((.path) entry)              | entry <- claimed              ]     evidenceTag ClaimedFromRecord = "record"     evidenceTag ClaimedFromBanner = "banner"-    staleSection = case mrLikelyStale report of+    staleSection = case (.likelyStale) report of       [] -> []       stale ->         [ "  likely stale: "@@ -258,13 +258,13 @@             <> " file(s) the legacy scaffold recorded that this workspace does not produce:"         ]           <> map staleLine stale-    staleLine stale = case (staleKind stale, staleGeneratedEvidence stale) of+    staleLine stale = case ((.kind) stale, (.generatedEvidence) stale) of       (Generated, Just ExactGeneratedBannerPresent) ->-        "    generated " <> T.pack (stalePath stale) <> "  (exact generated banner present; verify unchanged bytes before deleting)"+        "    generated " <> T.pack ((.path) stale) <> "  (exact generated banner present; verify unchanged bytes before deleting)"       (Generated, _) ->-        "    generated " <> T.pack (stalePath stale) <> "  (exact generated banner missing; preserve and review)"-      (HoleStub, _) -> "    hole      " <> T.pack (stalePath stale) <> "  (hand-owned — preserve and review)"-    unclaimedSection = case mrUnclaimed report of+        "    generated " <> T.pack ((.path) stale) <> "  (exact generated banner missing; preserve and review)"+      (HoleStub, _) -> "    hole      " <> T.pack ((.path) stale) <> "  (hand-owned — preserve and review)"+    unclaimedSection = case (.unclaimed) report of       [] -> []       unclaimed ->         [ "  unclaimed: "

src/Keiro/Dsl/WorkspaceDiff.hs view

@@ -45,13 +45,13 @@   where     annotate change =       WorkspaceChange-        { wcChange = change,-          wcDeclarationSite =+        { change = change,+          declarationSite =             ownedSiteForName new (declarationName kind)               <|> ownedSiteForName old (declarationName kind),-          wcUseSites =+          useSites =             [ (path, ownedSiteForName new (pathRoot path) <|> ownedSiteForName old (pathRoot path))-            | path <- ckPaths kind+            | path <- (.paths) kind             ]         }       where@@ -60,50 +60,50 @@ memberLanguageChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange] memberLanguageChanges old new =   [ WorkspaceChange-      { wcChange = change,-        wcDeclarationSite = Just (OwnedSite path (sourceLine (wmSourceLanguage newMember))),-        wcUseSites = []+      { change = change,+        declarationSite = Just (OwnedSite path (sourceLine ((.sourceLanguage) newMember))),+        useSites = []       }   | (path, newMember) <- Map.toAscList newByPath,     Just oldMember <- [Map.lookup path oldByPath],-    change <- sourceLanguageChange (wsService new) (T.pack path) (wmSourceLanguage oldMember) (wmSourceLanguage newMember)+    change <- sourceLanguageChange ((.service) new) (T.pack path) ((.sourceLanguage) oldMember) ((.sourceLanguage) newMember)   ]   where-    oldByPath = Map.fromList [(wmPath member, member) | member <- wsMembers old]-    newByPath = Map.fromList [(wmPath member, member) | member <- wsMembers new]+    oldByPath = Map.fromList [((.path) member, member) | member <- (.members) old]+    newByPath = Map.fromList [((.path) member, member) | member <- (.members) new]     sourceLine LegacyUnversioned = 1     sourceLine DeclaredLanguage {languageVersionLoc = Loc lineNumber} = lineNumber  -- | Preserve the existing headline/vector bytes and append indented citations. renderWorkspaceFinding :: WorkspaceChange -> Text renderWorkspaceFinding workspaceChange =-  T.intercalate "\n" (renderFinding (wcChange workspaceChange) : declarationLine <> useLines)+  T.intercalate "\n" (renderFinding ((.change) workspaceChange) : declarationLine <> useLines)   where-    declarationLine = case wcDeclarationSite workspaceChange of+    declarationLine = case (.declarationSite) workspaceChange of       Nothing -> []       Just site -> ["    declared: " <> renderOwnedSite site]     useLines =       [ "    use-site: " <> path <> " (" <> renderOwnedSite site <> ")"-      | (path, Just site) <- wcUseSites workspaceChange+      | (path, Just site) <- (.useSites) workspaceChange       ]  renderOwnedSite :: OwnedSite -> Text-renderOwnedSite site = T.pack (osFile site) <> ":" <> T.pack (show (osLine site))+renderOwnedSite site = T.pack ((.file) site) <> ":" <> T.pack (show ((.line) site))  ownedSiteForName :: WorkspaceSpec -> Name -> Maybe OwnedSite ownedSiteForName workspace name = do   (_, (file, Loc line)) <- find ((== name) . snd . fst) entries   pure (OwnedSite file line)   where-    ownership = wsOwnership workspace-    entries = Map.toAscList (oiDeclarations ownership) <> Map.toAscList (oiNodes ownership)+    ownership = (.ownership) workspace+    entries = Map.toAscList ((.declarations) ownership) <> Map.toAscList ((.nodes) ownership)  declarationName :: ChangeKind -> Name declarationName kind-  | "mapped-" `T.isPrefixOf` ckFacet kind,-    Just mapped <- mappedNameFromSubject (ckSubject kind) =+  | "mapped-" `T.isPrefixOf` (.facet) kind,+    Just mapped <- mappedNameFromSubject ((.subject) kind) =       mapped-  | otherwise = ckNode kind+  | otherwise = (.node) kind  mappedNameFromSubject :: Text -> Maybe Name mappedNameFromSubject subject =@@ -126,7 +126,7 @@ ownershipMoveChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange] ownershipMoveChanges old new =   [ WorkspaceChange-      { wcChange =+      { change =           advisoryAt             (consumerBuildContext name [])             name@@ -139,40 +139,40 @@                 <> T.pack newFile                 <> "; source ownership changed while wire evolution remains independently classified"             ),-        wcDeclarationSite = Just (OwnedSite newFile (unLoc newLoc)),-        wcUseSites = []+        declarationSite = Just (OwnedSite newFile ((.unLoc) newLoc)),+        useSites = []       }-  | (key@(_, name), (oldFile, _)) <- Map.toAscList (ownershipEntries (wsOwnership old)),-    Just (newFile, newLoc) <- [Map.lookup key (ownershipEntries (wsOwnership new))],+  | (key@(_, name), (oldFile, _)) <- Map.toAscList (ownershipEntries ((.ownership) old)),+    Just (newFile, newLoc) <- [Map.lookup key (ownershipEntries ((.ownership) new))],     oldFile /= newFile   ]  ownershipEntries :: OwnershipIndex -> Map.Map (Text, Name) (FilePath, Loc)-ownershipEntries ownership = oiDeclarations ownership <> oiNodes ownership+ownershipEntries ownership = (.declarations) ownership <> (.nodes) ownership  authorityChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange] authorityChanges old new =   concat-    [ changed "service-identity" (wsService old) (wsService new) serviceDetail,-      changed "context" (wsContext old) (wsContext new) contextDetail,-      changed "module-root" (renderModuleRoot (wsModuleRoot old)) (renderModuleRoot (wsModuleRoot new)) moduleDetail,-      changed "layout" (renderLayout (wsLayout old)) (renderLayout (wsLayout new)) layoutDetail+    [ changed "service-identity" ((.service) old) ((.service) new) serviceDetail,+      changed "context" ((.context) old) ((.context) new) contextDetail,+      changed "module-root" (renderModuleRoot ((.moduleRoot) old)) (renderModuleRoot ((.moduleRoot) new)) moduleDetail,+      changed "layout" (renderLayout ((.layout) old)) (renderLayout ((.layout) new)) layoutDetail     ]   where     changed field before after detail       | before == after = []       | otherwise =           [ WorkspaceChange-              { wcChange =+              { change =                   advisoryAt-                    (consumerBuildContext (wsService new) [])-                    (wsService new)+                    (consumerBuildContext ((.service) new) [])+                    ((.service) new)                     "workspace-authority"                     field                     WorkspaceAuthorityChanged                     (field <> " changed '" <> before <> "' -> '" <> after <> "'; " <> detail),-                wcDeclarationSite = Nothing,-                wcUseSites = []+                declarationSite = Nothing,+                useSites = []               }           ]     serviceDetail = "scaffold and compatibility history are re-keyed; follow the workspace adoption path"

src/Keiro/Dsl/WorkspaceRecord.hs view

@@ -79,23 +79,23 @@ -- directory, and which member file produced it ('Nothing' for context-level -- modules emitted once from the merged graph). data WorkspaceModuleRow = WorkspaceModuleRow-  { wrmKind :: !ModuleKind,-    wrmPath :: !FilePath,-    wrmOwner :: !(Maybe FilePath),-    wrmRole :: !(Maybe ModuleRole)+  { kind :: !ModuleKind,+    path :: !FilePath,+    owner :: !(Maybe FilePath),+    role :: !(Maybe ModuleRole)   }   deriving stock (Eq, Show)  instance ToJSON WorkspaceModuleRow where   toJSON row =     object $-      [ "kind" .= (case wrmKind row of Generated -> "generated" :: Text; HoleStub -> "hole"),-        "path" .= T.pack (wrmPath row)+      [ "kind" .= (case (.kind) row of Generated -> "generated" :: Text; HoleStub -> "hole"),+        "path" .= T.pack ((.path) row)       ]-        <> ["owner" .= T.pack owner | Just owner <- [wrmOwner row]]-        <> ["roleOwnerKind" .= roleOwnerKind role | Just role <- [wrmRole row]]-        <> ["roleOwnerName" .= roleOwnerName role | Just role <- [wrmRole row]]-        <> ["roleFamily" .= roleFamily role | Just role <- [wrmRole row]]+        <> ["owner" .= T.pack owner | Just owner <- [(.owner) row]]+        <> ["roleOwnerKind" .= (.ownerKind) role | Just role <- [(.role) row]]+        <> ["roleOwnerName" .= (.ownerName) role | Just role <- [(.role) row]]+        <> ["roleFamily" .= (.family) role | Just role <- [(.role) row]]  instance FromJSON WorkspaceModuleRow where   parseJSON = withObject "WorkspaceModuleRow" $ \fields -> do@@ -115,29 +115,29 @@       _ -> fail "module role fields must be all present or all absent"     pure       WorkspaceModuleRow-        { wrmKind = moduleKind,-          wrmPath = T.unpack (path :: Text),-          wrmOwner = T.unpack <$> (owner :: Maybe Text),-          wrmRole = moduleRoleValue+        { kind = moduleKind,+          path = T.unpack (path :: Text),+          owner = T.unpack <$> (owner :: Maybe Text),+          role = moduleRoleValue         }  -- | One member's source-language provenance in a workspace record. data WorkspaceSourceLanguageRow = WorkspaceSourceLanguageRow-  { wrslPath :: !FilePath,-    wrslSourceLanguage :: !SourceLanguage+  { path :: !FilePath,+    sourceLanguage :: !SourceLanguage   }   deriving stock (Eq, Show)  instance ToJSON WorkspaceSourceLanguageRow where   toJSON row =     object-      [ "path" .= T.pack (wrslPath row),+      [ "path" .= T.pack ((.path) row),         "sourceForm" .= sourceFormText sourceLanguage,         "declaredLanguageVersion" .= declaredLanguageVersionMaybe sourceLanguage,         "effectiveLanguageVersion" .= effectiveLanguageVersion sourceLanguage       ]     where-      sourceLanguage = wrslSourceLanguage row+      sourceLanguage = (.sourceLanguage) row  instance FromJSON WorkspaceSourceLanguageRow where   parseJSON value@(Aeson.Object fields) = do@@ -145,8 +145,8 @@     sourceLanguage <- parseJSON value     pure       WorkspaceSourceLanguageRow-        { wrslPath = T.unpack (path :: Text),-          wrslSourceLanguage = sourceLanguage+        { path = T.unpack (path :: Text),+          sourceLanguage = sourceLanguage         }   parseJSON _ = fail "WorkspaceSourceLanguageRow must be an object" @@ -156,21 +156,21 @@ -- carries the @-- \@generated@ banner but no surviving record lists it (the orphan -- case created when one legacy record overwrote another). data AdoptedRow = AdoptedRow-  { adPath :: !FilePath,-    adEvidence :: !Text,+  { path :: !FilePath,+    evidence :: !Text,     -- | The legacy record's file name, when the evidence is @record@.-    adSource :: !(Maybe Text),+    source :: !(Maybe Text),     -- | The legacy record's @spec:@ field, when available.-    adSpec :: !(Maybe Text)+    spec :: !(Maybe Text)   }   deriving stock (Eq, Show)  instance ToJSON AdoptedRow where   toJSON row =     object $-      ["path" .= T.pack (adPath row), "evidence" .= adEvidence row]-        <> ["source" .= source | Just source <- [adSource row]]-        <> ["spec" .= specPath | Just specPath <- [adSpec row]]+      ["path" .= T.pack ((.path) row), "evidence" .= (.evidence) row]+        <> ["source" .= source | Just source <- [(.source) row]]+        <> ["spec" .= specPath | Just specPath <- [(.spec) row]]  instance FromJSON AdoptedRow where   parseJSON = withObject "AdoptedRow" $ \fields -> do@@ -180,41 +180,41 @@     specPath <- fields .:? "spec"     pure       AdoptedRow-        { adPath = T.unpack (path :: Text),-          adEvidence = evidence,-          adSource = source,-          adSpec = specPath+        { path = T.unpack (path :: Text),+          evidence = evidence,+          source = source,+          spec = specPath         }  -- | Everything one successful whole-workspace scaffold produced. data WorkspaceRecord = WorkspaceRecord   { -- | The manifest's @service@ name: the workspace's durable identity.-    wrService :: !Text,+    service :: !Text,     -- | The manifest's __file name__, not a path. Members are relative to its     --     directory, so the directory is wherever the manifest currently sits;     --     recording only the name keeps the record independent of the invoking     --     working directory, which is what makes byte-identical output provable.-    wrManifest :: !Text,-    wrContext :: !Text,-    wrModuleRoot :: !Text,-    wrLayout :: !Text,+    manifest :: !Text,+    context :: !Text,+    moduleRoot :: !Text,+    layout :: !Text,     -- | Canonically ordered manifest-relative member paths.-    wrMembers :: ![FilePath],-    wrSourceLanguages :: ![WorkspaceSourceLanguageRow],-    wrLanguageContract :: !EffectiveLanguageContract,-    wrNamingEdition :: !GeneratedHaskellNamingEdition,-    wrModules :: ![WorkspaceModuleRow],-    wrMappings :: ![MappingIdentity],-    wrIdDomains :: ![Text],-    wrNominalEqualities :: ![Text],-    wrBindingObligations :: ![BindingHole],-    wrBehaviorRequirements :: ![BehaviorRecordRow],-    wrProjectionCatalogFacts :: ![Text],-    wrQueryContractBaseline :: !Bool,-    wrQueryContracts :: ![QueryContractIdentity],-    wrRouterSelections :: ![RouterSelectionSnapshot],-    wrAdopted :: ![AdoptedRow],-    wrSemanticImpact :: !(Maybe SemanticImpactSnapshot)+    members :: ![FilePath],+    sourceLanguages :: ![WorkspaceSourceLanguageRow],+    languageContract :: !EffectiveLanguageContract,+    namingEdition :: !GeneratedHaskellNamingEdition,+    modules :: ![WorkspaceModuleRow],+    mappings :: ![MappingIdentity],+    idDomains :: ![Text],+    nominalEqualities :: ![Text],+    bindingObligations :: ![BindingHole],+    requirements :: ![BehaviorRecordRow],+    projectionCatalogFacts :: ![Text],+    queryContractBaseline :: !Bool,+    queryContracts :: ![QueryContractIdentity],+    routerSelections :: ![RouterSelectionSnapshot],+    adopted :: ![AdoptedRow],+    semanticImpact :: !(Maybe SemanticImpactSnapshot)   }   deriving stock (Eq, Show) @@ -225,30 +225,30 @@ renderWorkspaceRecord record =   T.unlines $     [ workspaceRecordHeader,-      "service: " <> wrService record,-      "manifest: " <> wrManifest record,-      "context: " <> wrContext record,+      "service: " <> (.service) record,+      "manifest: " <> (.manifest) record,+      "context: " <> (.context) record,       "module-root: " <> rootLabel,-      "layout: " <> wrLayout record,-      "naming-edition " <> renderGeneratedHaskellNamingEdition (wrNamingEdition record)+      "layout: " <> (.layout) record,+      "naming-edition " <> renderGeneratedHaskellNamingEdition ((.namingEdition) record)     ]-      <> ["member " <> T.pack path | path <- wrMembers record]-      <> ["source-language " <> encodeRow row | row <- wrSourceLanguages record]-      <> ["semantic-contract " <> encodeRow (wrLanguageContract record)]-      <> ["module " <> encodeRow row | row <- wrModules record]-      <> [mappingRowPrefix mapping <> encodeRow mapping | mapping <- wrMappings record]-      <> ["id-domain " <> identity | identity <- wrIdDomains record]-      <> ["nominal-equality " <> identity | identity <- wrNominalEqualities record]-      <> ["binding " <> encodeRow obligation | obligation <- wrBindingObligations record]-      <> ["behavior " <> encodeRow requirement | requirement <- wrBehaviorRequirements record]-      <> ["projection-catalog-fact " <> fact | fact <- wrProjectionCatalogFacts record]-      <> ["query-contract-baseline v1" | wrQueryContractBaseline record]-      <> ["query-contract " <> encodeRow identity | identity <- wrQueryContracts record]-      <> ["router-selection " <> encodeRow selection | selection <- wrRouterSelections record]-      <> ["semantic-impact " <> encodeRow snapshot | Just snapshot <- [wrSemanticImpact record]]-      <> ["adopted " <> encodeRow adopted | adopted <- wrAdopted record]+      <> ["member " <> T.pack path | path <- (.members) record]+      <> ["source-language " <> encodeRow row | row <- (.sourceLanguages) record]+      <> ["semantic-contract " <> encodeRow ((.languageContract) record)]+      <> ["module " <> encodeRow row | row <- (.modules) record]+      <> [mappingRowPrefix mapping <> encodeRow mapping | mapping <- (.mappings) record]+      <> ["id-domain " <> identity | identity <- (.idDomains) record]+      <> ["nominal-equality " <> identity | identity <- (.nominalEqualities) record]+      <> ["binding " <> encodeRow obligation | obligation <- (.bindingObligations) record]+      <> ["behavior " <> encodeRow requirement | requirement <- (.requirements) record]+      <> ["projection-catalog-fact " <> fact | fact <- (.projectionCatalogFacts) record]+      <> ["query-contract-baseline v1" | (.queryContractBaseline) record]+      <> ["query-contract " <> encodeRow identity | identity <- (.queryContracts) record]+      <> ["router-selection " <> encodeRow selection | selection <- (.routerSelections) record]+      <> ["semantic-impact " <> encodeRow snapshot | Just snapshot <- [(.semanticImpact) record]]+      <> ["adopted " <> encodeRow adopted | adopted <- (.adopted) record]   where-    rootLabel = if T.null (wrModuleRoot record) then "(none)" else wrModuleRoot record+    rootLabel = if T.null ((.moduleRoot) record) then "(none)" else (.moduleRoot) record  encodeRow :: (ToJSON a) => a -> Text encodeRow = Text.decodeUtf8 . BL.toStrict . Aeson.encode@@ -277,49 +277,49 @@         let idDomains = [identity | row <- rows, Just identity <- [T.stripPrefix "id-domain " row]]         let nominalEqualities = [identity | row <- rows, Just identity <- [T.stripPrefix "nominal-equality " row]]         obligations <- traverse (decodeRow "binding ") (rowsWith "binding " rows)-        behaviorRequirements <- traverse (decodeRow "behavior ") (rowsWith "behavior " rows)+        requirements <- traverse (decodeRow "behavior ") (rowsWith "behavior " rows)         let catalogFacts = [fact | row <- rows, Just fact <- [T.stripPrefix "projection-catalog-fact " row]]         queryContractBaseline <- parseQueryContractBaseline rows         queryContracts <- traverse (decodeRow "query-contract ") (rowsWith "query-contract " rows)         routerSelections <- traverse (decodeRow "router-selection ") (rowsWith "router-selection " rows)         semanticImpact <- parseSemanticImpact rows-        adopted <- traverse (decodeRow "adopted ") (rowsWith "adopted " rows)+        adopted <- (traverse (decodeRow "adopted ") (rowsWith "adopted " rows) :: Maybe [AdoptedRow])         checkedAdopted <- traverse checkedAdoption adopted         if hasDuplicates members-          || hasDuplicates (map wrmPath checkedModules)-          || hasDuplicates (map mappingSpecName mappings)+          || hasDuplicates (map (.path) checkedModules)+          || hasDuplicates (map (.specName) mappings)           || hasDuplicates idDomains           || hasDuplicates nominalEqualities           || hasDuplicates (map bindingKey obligations)-          || hasDuplicates (map behaviorRecordKey behaviorRequirements)+          || hasDuplicates (map (.key) requirements)           || hasDuplicates catalogFacts           || hasDuplicates (map queryContractIdentityKey queryContracts)-          || hasDuplicates (map selectionRouter routerSelections)+          || hasDuplicates (map (.router) routerSelections)           then Nothing           else             pure               WorkspaceRecord-                { wrService = service,-                  wrManifest = manifest,-                  wrContext = context,-                  wrModuleRoot = if rootLabel == "(none)" then "" else rootLabel,-                  wrLayout = layout,-                  wrMembers = members,-                  wrSourceLanguages = sourceLanguages,-                  wrLanguageContract = languageContract,-                  wrNamingEdition = namingEdition,-                  wrModules = checkedModules,-                  wrMappings = mappings,-                  wrIdDomains = idDomains,-                  wrNominalEqualities = nominalEqualities,-                  wrBindingObligations = obligations,-                  wrBehaviorRequirements = behaviorRequirements,-                  wrProjectionCatalogFacts = catalogFacts,-                  wrQueryContractBaseline = queryContractBaseline,-                  wrQueryContracts = queryContracts,-                  wrRouterSelections = routerSelections,-                  wrAdopted = checkedAdopted,-                  wrSemanticImpact = semanticImpact+                { service = service,+                  manifest = manifest,+                  context = context,+                  moduleRoot = if rootLabel == "(none)" then "" else rootLabel,+                  layout = layout,+                  members = members,+                  sourceLanguages = sourceLanguages,+                  languageContract = languageContract,+                  namingEdition = namingEdition,+                  modules = checkedModules,+                  mappings = mappings,+                  idDomains = idDomains,+                  nominalEqualities = nominalEqualities,+                  bindingObligations = obligations,+                  requirements = requirements,+                  projectionCatalogFacts = catalogFacts,+                  queryContractBaseline = queryContractBaseline,+                  queryContracts = queryContracts,+                  routerSelections = routerSelections,+                  adopted = checkedAdopted,+                  semanticImpact = semanticImpact                 }   _ -> Nothing   where@@ -330,23 +330,37 @@     decodeRow prefix row = do       payload <- T.stripPrefix prefix row       Aeson.decodeStrict' (Text.encodeUtf8 payload)+    checkedModule :: WorkspaceModuleRow -> Maybe WorkspaceModuleRow     checkedModule row = do-      path <- safePath (T.pack (wrmPath row))-      owner <- traverse (safePath . T.pack) (wrmOwner row)-      pure row {wrmPath = path, wrmOwner = owner}+      path <- safePath (T.pack ((.path) row))+      owner <- traverse (safePath . T.pack) ((.owner) row)+      pure+        WorkspaceModuleRow+          { kind = (.kind) row,+            path = path,+            owner = owner,+            role = (.role) row+          }+    checkedAdoption :: AdoptedRow -> Maybe AdoptedRow     checkedAdoption row = do-      path <- safePath (T.pack (adPath row))-      pure row {adPath = path}+      path <- safePath (T.pack ((.path) row))+      pure+        AdoptedRow+          { path = path,+            evidence = (.evidence) row,+            source = (.source) row,+            spec = (.spec) row+          }     parseSourceLanguages members rows = case rowsWith "source-language " rows of       [] -> Just [WorkspaceSourceLanguageRow path LegacyUnversioned | path <- members]       sourceRows -> do         decoded <- traverse (decodeRow "source-language ") sourceRows         checked <- traverse checkedSourceLanguage decoded-        if hasDuplicates (map wrslPath checked) || sort (map wrslPath checked) /= sort members+        if hasDuplicates (map (.path) checked) || sort (map (.path) checked) /= sort members           then Nothing           else Just checked     parseLanguageContract sourceLanguages rows = do-      let inferred = nub [effectiveLanguageContract (wrslSourceLanguage row) | row <- sourceLanguages]+      let inferred = nub [effectiveLanguageContract ((.sourceLanguage) row) | row <- sourceLanguages]       common <- case inferred of         [contract] -> Just contract         [] -> Just (effectiveLanguageContract LegacyUnversioned)@@ -369,9 +383,14 @@       [] -> Just False       ["query-contract-baseline v1"] -> Just True       _ -> Nothing+    checkedSourceLanguage :: WorkspaceSourceLanguageRow -> Maybe WorkspaceSourceLanguageRow     checkedSourceLanguage row = do-      path <- safePath (T.pack (wrslPath row))-      pure row {wrslPath = path}+      path <- safePath (T.pack ((.path) row))+      pure+        WorkspaceSourceLanguageRow+          { path = path,+            sourceLanguage = (.sourceLanguage) row+          }     safePath raw =       let path = T.unpack raw        in if null path || isAbsolute path || ".." `elem` splitDirectories path@@ -380,11 +399,11 @@     hasDuplicates :: (Eq a) => [a] -> Bool     hasDuplicates values = length values /= length (nub values)     bindingKey hole =-      ( holeMappedName hole,-        holeModule hole,-        holeSymbol hole,-        holeKind hole,-        holePath hole+      ( (.mappedName) hole,+        (.moduleName) hole,+        (.symbol) hole,+        (.kind) hole,+        (.path) hole       )  -- | @keiro-dsl-ledger.workspace.\<service\>.txt@ — the machine-owned workspace

src/Keiro/Dsl/WorkspaceScaffold.hs view

@@ -46,6 +46,8 @@     WorkspaceScaffoldReport (..),     executeWorkspaceScaffold,     executeWorkspaceScaffoldWithNameMigrations,+    executeWorkspaceScaffoldWithMigrations,+    readWorkspaceRecord,     renderWorkspaceScaffoldReport,   ) where@@ -92,25 +94,31 @@ import Keiro.Dsl.ScaffoldRecord (projectionCatalogFactsForService) import Keiro.Dsl.ScaffoldRun   ( GeneratedArtifactImpact,+    LedgerRead (..),     MappingDrift (..),+    PreparedGeneratedHaskellEditionMigration,     PreparedSourceMove,     QueryContractMigration (..),     Refusal (..),     StaleGeneratedEvidence (..),     StaleModule (..),     WriteDisposition (..),+    applyPreparedGeneratedHaskellEditionMigration,     applyPreparedSourceMoves,     behaviorDrift,     checkedSemanticImpactSnapshot,     constraintPlanForService,     generatedArtifactImpact,     inertNodesOf,+    ledgerToMaybe,     mappingDrift,     missingGeneratedBanners,     newBindingObligations,     obligationKindLabel,     planningGatePipeline,+    preflightGeneratedHaskellEditionMigration,     preflightSourceMoves,+    preparedGeneratedHaskellEditionImpact,     preparedSourceMove,     queryContractMigrations,     renderGeneratedArtifactImpact,@@ -119,12 +127,14 @@     renderSemanticImpactReport,     semanticImpactForMappingDrift,     staleAgainst,+    withGeneratedHaskellEditionSourceMoves,     withSidecarMovesApplied,   ) import Keiro.Dsl.SemanticContract (CheckedService, checkedLanguageContract, checkedSpec) import Keiro.Dsl.SemanticImpact (SemanticImpactReport, SemanticImpactSnapshot) import Keiro.Dsl.ServiceHarness (DuplicateServiceFactKey, serviceConformanceModuleName, serviceHarnessModule) import Keiro.Dsl.SidecarMigration+import Keiro.Dsl.SidecarNames (legacyWorkspaceRecordFileName) import Keiro.Dsl.StructuralConformance (structuralConformanceModule) import Keiro.Dsl.Validate (nodeIdentity) import Keiro.Dsl.Workspace (WorkspaceMember (..), WorkspaceSpec (..), checkedWorkspace, declarationOwner, nodeOwner)@@ -154,16 +164,16 @@ -- | The complete, refusal-free write set for one whole-workspace scaffold, with -- each module's producing member attached. data WorkspacePlan = WorkspacePlan-  { wpWorkspace :: !WorkspaceSpec,-    wpCheckedService :: !CheckedService,-    wpContext :: !Context,-    wpRuntimePackage :: !(Maybe RuntimePackageName),-    wpConformancePackage :: !(Maybe ConformancePackagePlan),+  { workspace :: !WorkspaceSpec,+    checkedService :: !CheckedService,+    context :: !Context,+    runtimePackage :: !(Maybe RuntimePackageName),+    conformancePackage :: !(Maybe ConformancePackagePlan),     -- | The one golden-payload root for the whole workspace. Carried here so     --     execution can refuse a member-adjacent fixture the root lacks before it     --     writes anything.-    wpGoldenRoot :: !FilePath,-    wpModules :: ![(ScaffoldModule, ModuleProvenance)]+    goldenRoot :: !FilePath,+    modules :: ![(ScaffoldModule, ModuleProvenance)]   }   deriving stock (Eq, Show) @@ -185,7 +195,7 @@   WorkspaceSpec ->   Either [Refusal] WorkspacePlan planWorkspaceScaffoldWithGoldens goldens goldenRoot ctx workspace =-  planWorkspaceScaffoldWithRuntimePackageAndGoldens goldens (wsRuntimePackage workspace) goldenRoot ctx workspace+  planWorkspaceScaffoldWithRuntimePackageAndGoldens goldens ((.runtimePackage) workspace) goldenRoot ctx workspace  planWorkspaceScaffoldWithRuntimePackageAndGoldens ::   [GoldenPayload] ->@@ -202,19 +212,19 @@     plannedPackage <- either (Left . map ConformancePackageRefusal) Right packagePlan     Right       WorkspacePlan-        { wpWorkspace = workspace,-          wpCheckedService = service,-          wpContext = ctx,-          wpRuntimePackage = runtimePackage,-          wpConformancePackage = plannedPackage,-          wpGoldenRoot = goldenRoot,-          wpModules = tagged+        { workspace = workspace,+          checkedService = service,+          context = ctx,+          runtimePackage = runtimePackage,+          conformancePackage = plannedPackage,+          goldenRoot = goldenRoot,+          modules = tagged         }   where     service = checkedWorkspace workspace     sourceEntries = do       requirements <- either (Left . pure . BehaviorRefusal) Right (deriveBehaviorRequirementsForService service)-      either (Left . pure . BehaviorSourceRefusal) Right (BehaviorSource.planBehaviorSourceMap requirements (wsSourceIndex workspace))+      either (Left . pure . BehaviorSourceRefusal) Right (BehaviorSource.planBehaviorSourceMap requirements ((.sourceIndex) workspace))     taggedModules = do       entries <- sourceEntries       either (Left . pure . DuplicateConformanceFactKeys) Right (workspaceModules goldens runtimePackage entries ctx workspace service)@@ -227,7 +237,7 @@       Right tagged -> Right (map fst tagged)     packagePlan =       traverse-        (\packageName -> planConformancePackage (WorkspaceConformanceService (wsService workspace)) packageName (serviceConformanceModuleName ctx) service)+        (\packageName -> planConformancePackage (WorkspaceConformanceService ((.service) workspace)) packageName (serviceConformanceModuleName ctx) service)         runtimePackage     packageGate = case packagePlan of       Left failures -> Left (map ConformancePackageRefusal failures)@@ -258,12 +268,12 @@       <> [attributedStamped ContextLevel m | m <- scaffoldProjectionCatalogForService ctx service]       <> concat         [ map (attributedStamped (nodeProvenance node)) (emittersFor node)-        | node <- specNodes merged+        | node <- (.nodes) merged         ]       <> facade   where     merged = checkedSpec service-    ownership = wsOwnership workspace+    ownership = (.ownership) workspace     stamp = stampGeneratedModule (checkedLanguageContract service)     attributedStamped provenance moduleValue =       let (annotated, attribution) = attributed provenance moduleValue@@ -312,7 +322,13 @@     -- what keeps it identical to the single-file path down to this field.     attributed provenance m = (annotate provenance m, provenance)     annotate (MemberOwned path) m-      | length (wsMembers workspace) > 1 = m {origin = T.pack path <> ": " <> origin m}+      | length workspace.members > 1 =+          ScaffoldModule+            { path = m.path,+              text = m.text,+              kind = m.kind,+              origin = T.pack path <> ": " <> m.origin+            }     annotate _ m = m  --------------------------------------------------------------------------------@@ -334,13 +350,13 @@ -- diagnostic at all. goldenRootDivergence :: FilePath -> WorkspaceSpec -> IO [Refusal] goldenRootDivergence workspaceRoot workspace = do-  stranded <- concat <$> traverse strandedFor (wsMembers workspace)+  stranded <- concat <$> traverse strandedFor ((.members) workspace)   pure [GoldenRootDivergence workspaceRoot stranded | not (null stranded)]   where-    manifestDir = takeDirectory (wsManifestPath workspace)-    strandedFor member = concat <$> traverse (check member) (upcastFixtures (wmSpec member))+    manifestDir = takeDirectory ((.manifestPath) workspace)+    strandedFor member = concat <$> traverse (check member) (upcastFixtures ((.spec) member))     check member relative = do-      let memberRoot = manifestDir </> takeDirectory (wmPath member) </> "golden-payloads"+      let memberRoot = manifestDir </> takeDirectory ((.path) member) </> "golden-payloads"       besideMember <- firstExisting memberRoot relative       case besideMember of         Nothing -> pure []@@ -362,13 +378,13 @@ -- spec's declared upcasters would load, in spec order. upcastFixtures :: Spec -> [FilePath] upcastFixtures spec =-  [ T.unpack (specContext spec) </> T.unpack (aggName aggregate) </> fixtureName event sourceVersion-  | NAggregate aggregate <- specNodes spec,-    event <- aggEvents aggregate,-    Just (sourceVersion, _) <- [evUpcastFrom event]+  [ T.unpack ((.context) spec) </> T.unpack ((.name) aggregate) </> fixtureName event sourceVersion+  | NAggregate aggregate <- (.nodes) spec,+    event <- (.events) aggregate,+    Just (sourceVersion, _) <- [(.upcastFrom) event]   ]   where-    fixtureName event sourceVersion = T.unpack (evName event) <> ".v" <> show sourceVersion <> ".json"+    fixtureName event sourceVersion = T.unpack ((.name) event) <> ".v" <> show sourceVersion <> ".json"  -------------------------------------------------------------------------------- -- Execution@@ -382,58 +398,58 @@ -- what stops "I moved this aggregate to another file" from looking like "another -- spec's leftovers". Whole-workspace diffing must classify it identically. data OwnershipMove = OwnershipMove-  { omPath :: !FilePath,-    omPrevious :: !(Maybe FilePath),-    omCurrent :: !(Maybe FilePath)+  { path :: !FilePath,+    previous :: !(Maybe FilePath),+    current :: !(Maybe FilePath)   }   deriving stock (Eq, Show)  data WorkspaceSourceLanguageDrift = WorkspaceSourceLanguageDrift-  { wsldPath :: !FilePath,-    wsldPrevious :: !SourceLanguage,-    wsldCurrent :: !SourceLanguage+  { path :: !FilePath,+    previous :: !SourceLanguage,+    current :: !SourceLanguage   }   deriving stock (Eq, Show)  -- | What one successful whole-workspace scaffold did. data WorkspaceScaffoldReport = WorkspaceScaffoldReport-  { wsrManifestPath :: !FilePath,-    wsrOutDir :: !FilePath,-    wsrService :: !Text,-    wsrContext :: !Context,-    wsrMembers :: ![FilePath],-    wsrDispositions :: ![(ScaffoldModule, ModuleProvenance, WriteDisposition)],-    wsrBuildManifestPath :: !FilePath,-    wsrRecordPath :: !FilePath,+  { manifestPath :: !FilePath,+    outDir :: !FilePath,+    service :: !Text,+    context :: !Context,+    members :: ![FilePath],+    dispositions :: ![(ScaffoldModule, ModuleProvenance, WriteDisposition)],+    buildManifestPath :: !FilePath,+    recordPath :: !FilePath,     -- | The manifest file name the previous workspace record was written from,     --     when it differs from this run's.-    wsrPreviousManifest :: !(Maybe Text),-    wsrStale :: ![StaleModule],-    wsrOwnershipMoves :: ![OwnershipMove],-    wsrConsumerPlan :: !ConsumerPlan,-    wsrConstraintPlan :: ![Text],-    wsrMappingDrift :: ![MappingDrift],-    wsrQueryContractBaselineUnavailable :: !Bool,-    wsrQueryContractDrift :: ![QueryContractDrift],-    wsrQueryContractMigrations :: ![QueryContractMigration],-    wsrSemanticImpact :: !SemanticImpactReport,-    wsrRouterSelectionDrift :: ![RouterSelectionDrift],-    wsrProjectionMappedImpact :: !(Maybe ProjectionMappedImpact),-    wsrGeneratedArtifactImpact :: ![GeneratedArtifactImpact],-    wsrSourceLanguageDrift :: ![WorkspaceSourceLanguageDrift],-    wsrNewHoles :: ![BindingHole],-    wsrAddedBehavior :: ![BehaviorRecordRow],-    wsrRemovedBehavior :: ![BehaviorRecordRow],-    wsrObsoleteOutputHooks :: ![(Text, Text)],+    previousManifest :: !(Maybe Text),+    stale :: ![StaleModule],+    ownershipMoves :: ![OwnershipMove],+    consumerPlan :: !ConsumerPlan,+    constraintPlan :: ![Text],+    mappingDrift :: ![MappingDrift],+    queryContractBaselineUnavailable :: !Bool,+    queryContractDrift :: ![QueryContractDrift],+    queryContractMigrations :: ![QueryContractMigration],+    semanticImpact :: !SemanticImpactReport,+    routerSelectionDrift :: ![RouterSelectionDrift],+    projectionMappedImpact :: !(Maybe ProjectionMappedImpact),+    generatedArtifactImpact :: ![GeneratedArtifactImpact],+    sourceLanguageDrift :: ![WorkspaceSourceLanguageDrift],+    newHoles :: ![BindingHole],+    addedBehavior :: ![BehaviorRecordRow],+    removedBehavior :: ![BehaviorRecordRow],+    obsoleteOutputHooks :: ![(Text, Text)],     -- | Declarations in the merged service that produce no generated module.     --     Same content, same rendering as the single-spec     --     'Keiro.Dsl.ScaffoldRun.reportInertNodes'.-    wsrInertNodes :: ![(Text, Text)],-    wsrConformancePackage :: !(Maybe ConformancePackageReport),-    wsrNameMoves :: ![SourceMove],-    wsrSidecarMoves :: ![SidecarMove],+    inertNodes :: ![(Text, Text)],+    conformancePackage :: !(Maybe ConformancePackageReport),+    nameMoves :: ![SourceMove],+    sidecarMoves :: ![SidecarMove],     -- | Present only on the run that adopted pre-workspace scaffold output.-    wsrMigration :: !(Maybe MigrationReport)+    migration :: !(Maybe MigrationReport)   }   deriving stock (Eq, Show) @@ -461,40 +477,83 @@   executeWorkspaceScaffoldWithNameMigrations out forceGeneratedOverwrite False  executeWorkspaceScaffoldWithNameMigrations :: FilePath -> Bool -> Bool -> WorkspacePlan -> IO (Either [Refusal] WorkspaceScaffoldReport)-executeWorkspaceScaffoldWithNameMigrations out forceGeneratedOverwrite applyNameMigrations plan = do-  sidecarResult <- planSidecarMigrations out (WorkspaceSidecars (wsService (wpWorkspace plan))) (wpConformancePackage plan)+executeWorkspaceScaffoldWithNameMigrations out forceGeneratedOverwrite applyNameMigrations =+  executeWorkspaceScaffoldWithMigrations out forceGeneratedOverwrite applyNameMigrations False++executeWorkspaceScaffoldWithMigrations :: FilePath -> Bool -> Bool -> Bool -> WorkspacePlan -> IO (Either [Refusal] WorkspaceScaffoldReport)+executeWorkspaceScaffoldWithMigrations out forceGeneratedOverwrite applyNameMigrations applyGeneratedHaskellEdition plan = do+  sidecarResult <- planSidecarMigrations out (WorkspaceSidecars service) ((.conformancePackage) plan)   case sidecarResult of     Left reasons -> pure (Left [SidecarMigrationRefusal reasons])-    Right preparedSidecars-      | not (null preparedSidecars) && not applyNameMigrations ->-          pure (Left [SidecarMigrationRequired (map preparedSidecarMove preparedSidecars)])-      | otherwise -> do-          applyPreparedSidecarMoves out preparedSidecars-          -- Past this point the renames are on disk, so a later refusal's-          -- "nothing was written" needs qualifying. Mirrors the single-spec path.-          let sidecarMoves = map preparedSidecarMove preparedSidecars-              noteApplied = withSidecarMovesApplied sidecarMoves-          previous <- readWorkspaceRecord recordPath-          result <- case planWorkspaceSourceMoves previous modules of-            Left moveErrors -> pure (Left [NameMigrationRefusal [T.pack (show moveError) | moveError <- NE.toList moveErrors]])-            Right moves -> do-              preparedMoves <- preflightSourceMoves out moves-              case preparedMoves of-                Left moveErrors -> pure (Left [NameMigrationRefusal moveErrors])-                Right prepared-                  | not (null prepared) && not applyNameMigrations -> pure (Left [NameMigrationRequired (map preparedSourceMove prepared)])<